/[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 54 by guez, Tue Dec 6 15:07:04 2011 UTC trunk/Sources/phylmd/physiq.f revision 206 by guez, Tue Aug 30 12:52:46 2016 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
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
     USE calendar, ONLY: ymds2ju  
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
21      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ok_instan
23      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &
24           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf
25      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
26      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use clouds_gno_m, only: clouds_gno
27        use comconst, only: dtphys
28        USE comgeomphy, ONLY: airephy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, day_step, iphysiq, lmt_pas
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32        use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
35      use diagetpq_m, only: diagetpq      USE dimens_m, ONLY: llm, nqmx
36      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimphy, ONLY: klon
     USE dimphy, ONLY: klon, nbtr  
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39        use dynetat0_m, only: day_ref, annee_ref
40      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
41        use fisrtilp_m, only: fisrtilp
42      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
43      USE histcom, ONLY: histsync      USE histsync_m, ONLY: histsync
44      USE histwrite_m, ONLY: histwrite      USE histwrite_phy_m, ONLY: histwrite_phy
45      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
46           nbsrf           nbsrf
47      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histins_m, ONLY: ini_histins, nid_ins
48      USE ini_histday_m, ONLY: ini_histday      use netcdf95, only: NF95_CLOSE
49      USE ini_histins_m, ONLY: ini_histins      use newmicro_m, only: newmicro
50      USE oasis_m, ONLY: ok_oasis      use nr_util, only: assert
51      USE orbite_m, ONLY: orbite, zenang      use nuage_m, only: nuage
52        USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56        USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
59      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
60      use sugwd_m, only: sugwd      use yoegwd, only: sugwd
61      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62      USE temps, ONLY: annee_ref, day_ref, itau_phy      use time_phylmdz, only: itap, increment_itap
63        use transp_m, only: transp
64        use transp_lay_m, only: transp_lay
65        use unit_nml_m, only: unit_nml
66        USE ymds2ju_m, ONLY: ymds2ju
67      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
68        use zenang_m, only: zenang
69    
     ! Arguments:  
   
     REAL, intent(in):: rdayvrai  
     ! (elapsed time since January 1st 0h of the starting year, in days)  
   
     REAL, intent(in):: time ! heure de la journée en fraction de jour  
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
70      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
71    
72      REAL, intent(in):: paprs(klon, llm + 1)      integer, intent(in):: dayvrai
73      ! (pression pour chaque inter-couche, en Pa)      ! current day number, based at value 1 on January 1st of annee_ref
74    
75      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     ! (input pression pour le mileu de chaque couche (en Pa))  
76    
77      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
78      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! pression pour chaque inter-couche, en Pa
79    
80      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: play(:, :) ! (klon, llm)
81        ! pression pour le mileu de chaque couche (en Pa)
82    
83      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
84      ! vitesse dans la direction X (de O a E) en m/s      ! géopotentiel de chaque couche (référence sol)
85    
86      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
     REAL, intent(in):: t(klon, llm) ! input temperature (K)  
87    
88      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: u(:, :) ! (klon, llm)
89      ! (humidité spécifique et fractions massiques des autres traceurs)      ! vitesse dans la direction X (de O a E) en m / s
90    
91      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
92      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
     REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/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  
93    
94      LOGICAL:: firstcal = .true.      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
95        ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
96    
97      INTEGER nbteta      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
98      PARAMETER(nbteta = 3)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
99        REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
100        REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
101    
102      REAL PVteta(klon, nbteta)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
103      ! (output vorticite potentielle a des thetas constantes)      ! tendance physique de "qx" (s-1)
104    
105      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      ! Local:
     PARAMETER (ok_cvl = .TRUE.)  
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust = .FALSE.)  
106    
107      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL:: firstcal = .true.
     PARAMETER (check = .FALSE.)  
108    
109      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
111    
112      ! Parametres lies au coupleur OASIS:      ! pour phystoke avec thermiques
     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  
   
     ! "slab" ocean  
     REAL, save:: tslab(klon) ! temperature of ocean slab  
     REAL, save:: seaice(klon) ! glace de mer (kg/m2)  
     REAL fluxo(klon) ! flux turbulents ocean-glace de mer  
     REAL fluxg(klon) ! flux turbulents ocean-atmosphere  
   
     ! Modele thermique du sol, a activer pour le cycle diurne:  
     logical, save:: ok_veget  
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
   
     LOGICAL ok_instan ! sortir le fichier instantane  
     save ok_instan  
   
     LOGICAL ok_region ! sortir le fichier regional  
     PARAMETER (ok_region = .FALSE.)  
   
     ! pour phsystoke avec thermiques  
113      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
114      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
115      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
116    
117      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
118      PARAMETER (ivap = 1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq = 2)  
119    
120      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
121      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
122    
123      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
124      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
125    
126      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
127    
128      !IM Amip2 PV a theta constante      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
129        REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
130    
131      CHARACTER(LEN = 3) ctetaSTD(nbteta)      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
132      DATA ctetaSTD/'350', '380', '405'/      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     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)  
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)  
     REAL lwup0(klon, klevp1), lwup(klon, klevp1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     !IM Amip2  
     ! variables a une pression donnee  
   
     integer nlevSTD  
     PARAMETER(nlevSTD = 17)  
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN = 4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70 ', '50 ', '30 ', '20 ', '10 '/  
133    
134      ! prw: precipitable water      ! prw: precipitable water
135      real prw(klon)      real prw(klon)
136    
137      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
138      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
139      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
140      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
141    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)  
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN = 4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN = 3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     !IM ISCCP simulator v3.4  
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
   
142      ! Variables propres a la physique      ! Variables propres a la physique
143    
144      INTEGER, save:: radpas      INTEGER, save:: radpas
145      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
146      ! "physiq".)      ! "physiq".
   
     REAL radsol(klon)  
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
147    
148      INTEGER, SAVE:: itap ! number of calls to "physiq"      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
149    
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
151    
152      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
156      SAVE fevap ! evaporation      REAL, save:: fluxlat(klon, nbsrf)
     REAL fluxlat(klon, nbsrf)  
     SAVE fluxlat  
157    
158      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      SAVE fqsurf ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
160    
161      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: qsol(klon)
162        ! column-density of water in soil, in kg m-2
163    
164      REAL fsnow(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
165      SAVE fsnow ! epaisseur neigeuse      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
166    
167      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) :  
168      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
169      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
170      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 294  contains Line 173  contains
173      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
174      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
175      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
176      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
177        INTEGER igwd, itest(klon)
178    
179      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
180        REAL, save:: run_off_lic_0(klon)
181    
182      REAL agesno(klon, nbsrf)      ! Variables li\'ees \`a la convection d'Emanuel :
183      SAVE agesno ! age de la neige      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
184        REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
185      REAL run_off_lic_0(klon)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     SAVE run_off_lic_0  
     !KE43  
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
     REAL Ma(klon, llm) ! undilute upward mass flux  
     SAVE Ma  
     REAL qcondc(klon, llm) ! in-cld water content from convect  
     SAVE qcondc  
     REAL ema_work1(klon, llm), ema_work2(klon, llm)  
     SAVE ema_work1, ema_work2  
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
   
     ! Variables locales pour la couche limite (al1):  
   
     ! Variables locales:  
186    
187        ! Variables pour la couche limite (Alain Lahellec) :
188      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
189      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
190    
191      !AA Pour phytrac      ! Pour phytrac :
192      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
193      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
194      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
195      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
196      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: ffonte(klon, nbsrf)
197      ! !et necessaire pour limiter la      ! flux thermique utilise pour fondre la neige
198      ! !hauteur de neige, en kg/m2/s  
199        REAL, save:: fqcalving(klon, nbsrf)
200        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
201        ! hauteur de neige, en kg / m2 / s
202    
203      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
206      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
207      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
208      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
209      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
210      save pfrac_1nucl  
211      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
212      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
213    
214      !AA      REAL, save:: rain_fall(klon)
215      REAL rain_fall(klon) ! pluie      ! liquid water mass flux (kg / m2 / s), positive down
216      REAL snow_fall(klon) ! neige  
217      save snow_fall, rain_fall      REAL, save:: snow_fall(klon)
218      !IM cf FH pour Tiedtke 080604      ! solid water mass flux (kg / m2 / s), positive down
219    
220      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
221    
222      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon) ! flux d'\'evaporation au sol
223      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
224      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
225      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
226        REAL, save:: dlw(klon) ! derivee infra rouge
227      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
228      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
229      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
230      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
231      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
232      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
233    
234      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
235      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
236    
237      ! Conditions aux limites      ! Conditions aux limites
238    
239      INTEGER julien      INTEGER julien
240        REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
241      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      REAL, save:: albsol(klon) ! albedo du sol total visible
     REAL pctsrf(klon, nbsrf)  
     !IM  
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
   
     SAVE pctsrf ! sous-fraction du sol  
     REAL albsol(klon)  
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
242      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
243    
244      ! Declaration des procedures appelees      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
245        real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
     real clwcon(klon, llm), rnebcon(klon, llm)  
     real clwcon0(klon, llm), rnebcon0(klon, llm)  
   
     save rnebcon, clwcon  
246    
247      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
248      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 411  contains Line 252  contains
252      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
253      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
254    
255      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
256      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
257      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
258      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_v(klon, nbsrf) ! flux turbulent de vitesse v à la surface
   
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
259    
260      ! 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
261      ! que les variables soient rémanentes      ! les variables soient r\'emanentes.
262      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
263      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
264      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
265      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
266      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
267      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
268      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      real, save:: sollwdown(klon) ! downward LW flux at surface
269      REAL albpla(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
270      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL, save:: albpla(klon)
271      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
272      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
273      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
274        REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
275      INTEGER itaprad      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
     SAVE itaprad  
   
     REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)  
     REAL conv_t(klon, llm) ! convergence of temperature (K/s)  
   
     REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut  
     REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree  
   
     REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)  
   
     REAL dist, rmu0(klon), fract(klon)  
     REAL zdtime ! pas de temps du rayonnement (s)  
     real zlongi  
276    
277      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
278      LOGICAL zx_ajustq      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
279    
280        REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
281    
282      REAL za, zb      REAL dist, mu0(klon), fract(klon)
283      REAL zx_t, zx_qs, zdelta, zcor      real longi
284        REAL z_avant(klon), z_apres(klon), z_factor(klon)
285        REAL zb
286        REAL zx_t, zx_qs, zcor
287      real zqsat(klon, llm)      real zqsat(klon, llm)
288      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
289      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
290      REAL zphi(klon, llm)      REAL zphi(klon, llm)
291    
292      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
293    
294      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
295      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 473  contains Line 299  contains
299      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
300      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
301      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
302      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
303      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
304      ! Grdeurs de sorties      ! Grandeurs de sorties
305      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
306      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
307      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
308      REAL s_trmb3(klon)      REAL s_trmb3(klon)
309    
310      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables pour la convection de K. Emanuel :
311    
312      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
313      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
314      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
315      REAL tvp(klon, llm) ! virtual temp of lifted parcel  
     REAL cape(klon) ! CAPE  
     SAVE cape  
   
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
316      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)  
317    
318      ! Variables du changement      ! Variables du changement
319    
320      ! con: convection      ! con: convection
321      ! lsc: large scale condensation      ! lsc: large scale condensation
322      ! ajs: ajustement sec      ! ajs: ajustement sec
323      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
324      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
325      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
326      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
327      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
328      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
329      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
330      REAL rneb(klon, llm)      REAL rneb(klon, llm)
331    
332      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
333      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
334      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
335      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
336      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
337      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
338    
339      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
340        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
341    
342      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
343      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
344        REAL, save:: snow_con(klon) ! neige (mm / s)
345        real snow_lsc(klon)
346      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
347    
348      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 536  contains Line 353  contains
353      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
354      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
355    
356      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
357      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
358      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
359    
360      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
361      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
362      real, save:: facttemps      real:: facttemps = 1.e-4
363      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
364      real facteur      real facteur
365    
366      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
367      logical ptconv(klon, llm)      logical ptconv(klon, llm)
368    
369      ! Variables locales pour effectuer les appels en série :      ! Variables pour effectuer les appels en s\'erie :
370    
371      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
372      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
373      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
374        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
375    
376      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
377    
# Line 568  contains Line 380  contains
380      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
381      REAL aam, torsfc      REAL aam, torsfc
382    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
     INTEGER, SAVE:: nid_day, nid_ins  
   
383      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.
384      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.
385      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.
386      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.
387    
     REAL zsto  
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
388      real date0      real date0
   
     ! Variables liées au bilan d'énergie et d'enthalpie :  
389      REAL ztsol(klon)      REAL ztsol(klon)
     REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec  
     REAL, SAVE:: d_h_vcol_phy  
     REAL fs_bound, fq_bound  
     REAL zero_v(klon)  
     CHARACTER(LEN = 15) ztit  
     INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
     INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics  
390    
391      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm)
392        ! tendance due \`a la conversion Ec en énergie thermique
393    
394      REAL ZRCPD      REAL ZRCPD
395    
396      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
397      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      ! temperature and humidity at 2 m
398      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille  
399      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
400      !jq Aerosol effects (Johannes Quaas, 27/11/2003)      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
401      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
402    
403        ! Aerosol effects:
404    
405        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
406    
407      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
408      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
409    
410      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
411      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial aerosols
412    
413      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
414      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
415    
416      ! Aerosol optical properties      ! Aerosol optical properties
417      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
418      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
419    
420        REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
421        REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
422    
423      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
424      ! ok_ade = True -ADE = topswad-topsw      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
425    
426      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
427      ! ok_aie = True ->      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
428      ! ok_ade = True -AIE = topswai-topswad      ! B). They link cloud droplet number concentration to aerosol mass
429      ! ok_ade = F -AIE = topswai-topsw      ! concentration.
   
     REAL aerindex(klon) ! POLDER aerosol index  
   
     ! Parameters  
     LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not  
     REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
   
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
     SAVE u10m  
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
     SAVE rnebcon0  
     SAVE clwcon0  
430    
431      real zmasse(klon, llm)      real zmasse(klon, llm)
432      ! (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)
433    
434      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
435    
436        namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
437             ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
438             iflag_thermals, nsplit_thermals
439    
440      !----------------------------------------------------------------      !----------------------------------------------------------------
441    
442      modname = 'physiq'      IF (nqmx < 2) CALL abort_gcm('physiq', &
443      IF (if_ebil >= 1) THEN           'eaux vapeur et liquide sont indispensables')
        DO i = 1, klon  
           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  
444    
445      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
446         ! initialiser         ! initialiser
# Line 685  contains Line 453  contains
453         piz_ae = 0.         piz_ae = 0.
454         tau_ae = 0.         tau_ae = 0.
455         cg_ae = 0.         cg_ae = 0.
456         rain_con(:) = 0.         rain_con = 0.
457         snow_con(:) = 0.         snow_con = 0.
458         bl95_b0 = 0.         topswai = 0.
459         bl95_b1 = 0.         topswad = 0.
460         topswai(:) = 0.         solswai = 0.
461         topswad(:) = 0.         solswad = 0.
462         solswai(:) = 0.  
463         solswad(:) = 0.         d_u_con = 0.
464           d_v_con = 0.
465         d_u_con = 0.0         rnebcon0 = 0.
466         d_v_con = 0.0         clwcon0 = 0.
467         rnebcon0 = 0.0         rnebcon = 0.
468         clwcon0 = 0.0         clwcon = 0.
        rnebcon = 0.0  
        clwcon = 0.0  
469    
470         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
471         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 709  contains Line 475  contains
475         pblt =0. ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
476         therm =0.         therm =0.
477         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
478         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
479         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
480    
481         IF (if_ebil >= 1) d_h_vcol_phy = 0.         iflag_thermals = 0
482           nsplit_thermals = 1
483         ! appel a la lecture du run.def physique         print *, "Enter namelist 'physiq_nml'."
484           read(unit=*, nml=physiq_nml)
485           write(unit_nml, nml=physiq_nml)
486    
487         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)  
488    
489         ! Initialiser les compteurs:         ! Initialiser les compteurs:
490    
491         frugs = 0.         frugs = 0.
492         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
493         itaprad = 0              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
494         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
495              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
496              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              w01, ncid_startphy)
             zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &  
             ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)  
497    
498         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
499         q2 = 1.e-8         q2 = 1e-8
   
        radpas = NINT(86400. / dtphys / nbapp_rad)  
   
        ! on remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        PRINT *, 'cycle_diurne = ', cycle_diurne  
   
        IF(ocean.NE.'force ') THEN  
           ok_ocean = .TRUE.  
        ENDIF  
500    
501         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         radpas = lmt_pas / nbapp_rad
502              ok_region)         print *, "radpas = ", radpas
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message = 'Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        print *,"Clef pour la convection, iflag_con = ", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl = ", &  
             ok_cvl  
   
        ! Initialisation pour la convection de K.E. (sb):  
        IF (iflag_con >= 3) THEN  
   
           print *,"*** Convection de Kerry Emanuel 4.3 "  
   
           !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  
503    
504           ! Initialisation pour le sch\'ema de convection d'Emanuel :
505           IF (conv_emanuel) THEN
506              ibas_con = 1
507              itop_con = 1
508         ENDIF         ENDIF
509    
510         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 782  contains Line 514  contains
514            rugoro = 0.            rugoro = 0.
515         ENDIF         ENDIF
516    
517         lmt_pas = NINT(86400. / dtphys) ! tous les jours         ecrit_ins = NINT(ecrit_ins / dtphys)
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
        ecrit_ins = NINT(ecrit_ins/dtphys)  
        ecrit_hf = NINT(ecrit_hf/dtphys)  
        ecrit_mth = NINT(ecrit_mth/dtphys)  
        ecrit_tra = NINT(86400.*ecrit_tra/dtphys)  
        ecrit_reg = NINT(ecrit_reg/dtphys)  
   
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
518    
519         ! Initialisation des sorties         ! Initialisation des sorties
520    
521         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histins(dtphys)
522         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
523         call ini_histins(dtphys, ok_instan, nid_ins)         ! Positionner date0 pour initialisation de ORCHIDEE
524         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         print *, 'physiq date0: ', date0
525         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         CALL phyredem0
        WRITE(*, *) 'physiq date0: ', date0  
526      ENDIF test_firstcal      ENDIF test_firstcal
527    
528      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
529        ! u, v, t, qx:
530      DO i = 1, klon      t_seri = t
531         d_ps(i) = 0.0      u_seri = u
532      ENDDO      v_seri = v
533      DO iq = 1, nqmx      q_seri = qx(:, :, ivap)
534         DO k = 1, llm      ql_seri = qx(:, :, iliq)
535            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.  
   
     ! Ne pas affecter les valeurs entrées de u, v, h, et q :  
   
     DO k = 1, llm  
        DO i = 1, klon  
           t_seri(i, k) = t(i, k)  
           u_seri(i, k) = u(i, k)  
           v_seri(i, k) = v(i, k)  
           q_seri(i, k) = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
   
     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  
536    
537      IF (if_ebil >= 1) THEN      ztsol = sum(ftsol * pctsrf, dim = 2)
        ztit = 'after dynamics'  
        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        ! Comme les tendances de la physique sont ajoutés dans la  
        !  dynamique, la variation d'enthalpie par la dynamique devrait  
        !  être égale à la variation de la physique au pas de temps  
        !  précédent.  Donc la somme de ces 2 variations devrait être  
        !  nulle.  
        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_h_vcol_phy, &  
             d_qt, 0., fs_bound, fq_bound)  
     END IF  
538    
539      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
540      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 877  contains Line 547  contains
547      ELSE      ELSE
548         DO k = 1, llm         DO k = 1, llm
549            DO i = 1, klon            DO i = 1, klon
550               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
551               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
552            ENDDO            ENDDO
553         ENDDO         ENDDO
554         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 894  contains Line 564  contains
564      ! Check temperatures:      ! Check temperatures:
565      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
566    
567      ! Incrementer le compteur de la physique      call increment_itap
568      itap = itap + 1      julien = MOD(dayvrai, 360)
     julien = MOD(NINT(rdayvrai), 360)  
569      if (julien == 0) julien = 360      if (julien == 0) julien = 360
570    
571      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
   
     ! Mettre en action les conditions aux limites (albedo, sst, etc.).  
572    
573      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone :
574      if (nqmx >= 5) then      wo = ozonecm(REAL(julien), paprs)
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
575    
576      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
577      DO k = 1, llm      DO k = 1, llm
578         DO i = 1, klon         DO i = 1, klon
579            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 921  contains Line 584  contains
584      ENDDO      ENDDO
585      ql_seri = 0.      ql_seri = 0.
586    
587      IF (if_ebil >= 2) THEN      frugs = MAX(frugs, 0.000015)
588         ztit = 'after reevap'      zxrugs = sum(frugs * pctsrf, dim = 2)
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        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, &  
             fs_bound, fq_bound)  
589    
590      END IF      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
591        ! la surface.
592    
593      ! Appeler la diffusion verticale (programme de couche limite)      CALL orbite(REAL(julien), longi, dist)
   
     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  
   
     ! calculs necessaires au calcul de l'albedo dans l'interface  
   
     CALL orbite(REAL(julien), zlongi, dist)  
594      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
595         zdtime = dtphys * REAL(radpas)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
596      ELSE      ELSE
597         rmu0 = -999.999         mu0 = - 999.999
598      ENDIF      ENDIF
599    
600      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
601      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  
602    
603      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
604      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
605    
606      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
607         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
608            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
609                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
610            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))      END forall
        ENDDO  
     ENDDO  
611    
612      fder = dlw      fder = dlw
613    
614      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
615             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
616      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
617           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &
618           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, &
619           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           flux_v, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
620           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
621           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
622           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &  
623           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &      ! Incr\'ementation des flux
624           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &  
625           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)      sens = - sum(flux_t * pctsrf, dim = 2)
626        evap = - sum(flux_q * pctsrf, dim = 2)
627      ! Incrémentation des flux      fder = dlw + dsens + devap
   
     zxfluxt = 0.  
     zxfluxq = 0.  
     zxfluxu = 0.  
     zxfluxv = 0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) + &  
                   fluxt(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) + &  
                   fluxq(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxu(i, k) = zxfluxu(i, k) + &  
                   fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + &  
                   fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
628    
629      DO k = 1, llm      DO k = 1, llm
630         DO i = 1, klon         DO i = 1, klon
# Line 1029  contains Line 635  contains
635         ENDDO         ENDDO
636      ENDDO      ENDDO
637    
     IF (if_ebil >= 2) THEN  
        ztit = 'after clmain'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        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, &  
             fs_bound, fq_bound)  
     END IF  
   
638      ! Update surface temperature:      ! Update surface temperature:
639    
640      DO i = 1, klon      DO i = 1, klon
641         zxtsol(i) = 0.0         zxfluxlat(i) = 0.
        zxfluxlat(i) = 0.0  
642    
643         zt2m(i) = 0.0         zt2m(i) = 0.
644         zq2m(i) = 0.0         zq2m(i) = 0.
645         zu10m(i) = 0.0         zu10m(i) = 0.
646         zv10m(i) = 0.0         zv10m(i) = 0.
647         zxffonte(i) = 0.0         zxffonte(i) = 0.
648         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
649    
650         s_pblh(i) = 0.0         s_pblh(i) = 0.
651         s_lcl(i) = 0.0         s_lcl(i) = 0.
652         s_capCL(i) = 0.0         s_capCL(i) = 0.
653         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
654         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
655         s_pblT(i) = 0.0         s_pblT(i) = 0.
656         s_therm(i) = 0.0         s_therm(i) = 0.
657         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
658         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
659         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &  
             pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &  
             THEN  
           WRITE(*, *) 'physiq : pb sous surface au point ', i, &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
660      ENDDO      ENDDO
661    
662        call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
663    
664        ftsol = ftsol + d_ts
665        ztsol = sum(ftsol * pctsrf, dim = 2)
666      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
667         DO i = 1, klon         DO i = 1, klon
668            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)
669            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
670            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)            zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)
671              zq2m(i) = zq2m(i) + q2m(i, nsrf) * pctsrf(i, nsrf)
672            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf) * pctsrf(i, nsrf)
673            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf) * pctsrf(i, nsrf)
674            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf) * pctsrf(i, nsrf)
           zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)  
675            zxfqcalving(i) = zxfqcalving(i) + &            zxfqcalving(i) = zxfqcalving(i) + &
676                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf) * pctsrf(i, nsrf)
677            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf) * pctsrf(i, nsrf)
678            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf) * pctsrf(i, nsrf)
679            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) * pctsrf(i, nsrf)
680            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) * pctsrf(i, nsrf)
681            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) * pctsrf(i, nsrf)
682            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) * pctsrf(i, nsrf)
683            s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)            s_therm(i) = s_therm(i) + therm(i, nsrf) * pctsrf(i, nsrf)
684            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) * pctsrf(i, nsrf)
685            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) * pctsrf(i, nsrf)
686            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) * pctsrf(i, nsrf)
687         ENDDO         ENDDO
688      ENDDO      ENDDO
689    
690      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
   
691      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
692         DO i = 1, klon         DO i = 1, klon
693            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
694                 ftsol(i, nsrf) = ztsol(i)
695            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
696            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
697            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
698            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
699            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
700            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
701                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
702            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
703            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
704            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
705            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
706            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
707            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
708            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
709            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
710            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
711            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
712         ENDDO         ENDDO
713      ENDDO      ENDDO
714    
715      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
716    
717      DO i = 1, klon      DO i = 1, klon
718         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
719      ENDDO      ENDDO
720    
721      ! Appeler la convection (au choix)      ! Appeler la convection
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) &  
                + d_q_vdf(i, k)/dtphys  
           conv_t(i, k) = d_t_dyn(i, k) &  
                + d_t_vdf(i, k)/dtphys  
        ENDDO  
     ENDDO  
     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  
722    
723      select case (iflag_con)      if (conv_emanuel) then
724      case (1)         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
725         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
726         stop 1              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
727      case (2)         snow_con = 0.
728         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         clwcon0 = qcondc
729              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &         mfu = upwd + dnwd
730              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &  
731              pmflxs)         IF (thermcep) THEN
732         WHERE (rain_con < 0.) rain_con = 0.            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
733         WHERE (snow_con < 0.) snow_con = 0.            zqsat = zqsat / (1. - retv * zqsat)
        DO i = 1, klon  
           ibas_con(i) = llm + 1 - kcbot(i)  
           itop_con(i) = llm + 1 - kctop(i)  
        ENDDO  
     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  
734         ELSE         ELSE
735            ! conema3 ne contient pas les traceurs            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
           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)  
736         ENDIF         ENDIF
737    
738         IF (.NOT. ok_gust) THEN         ! Properties of convective clouds
739            do i = 1, klon         clwcon0 = fact_cldcon * clwcon0
740               wd(i) = 0.0         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
741            enddo              rnebcon0)
742         ENDIF  
743           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
744         ! Calcul des propriétés des nuages convectifs         mfd = 0.
745           pen_u = 0.
746         DO k = 1, llm         pen_d = 0.
747            DO i = 1, klon         pde_d = 0.
748               zx_t = t_seri(i, k)         pde_u = 0.
749               IF (thermcep) THEN      else
750                  zdelta = MAX(0., SIGN(1., rtt-zx_t))         conv_q = d_q_dyn + d_q_vdf / dtphys
751                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)         conv_t = d_t_dyn + d_t_vdf / dtphys
752                  zx_qs = MIN(0.5, zx_qs)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
753                  zcor = 1./(1.-retv*zx_qs)         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
754                  zx_qs = zx_qs*zcor              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
755               ELSE              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
756                  IF (zx_t < t_coup) THEN              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
757                     zx_qs = qsats(zx_t)/play(i, k)              kdtop, pmflxr, pmflxs)
758                  ELSE         WHERE (rain_con < 0.) rain_con = 0.
759                     zx_qs = qsatl(zx_t)/play(i, k)         WHERE (snow_con < 0.) snow_con = 0.
760                  ENDIF         ibas_con = llm + 1 - kcbot
761               ENDIF         itop_con = llm + 1 - kctop
762               zqsat(i, k) = zx_qs      END if
           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  
763    
764      DO k = 1, llm      DO k = 1, llm
765         DO i = 1, klon         DO i = 1, klon
# Line 1245  contains Line 770  contains
770         ENDDO         ENDDO
771      ENDDO      ENDDO
772    
773      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
774         ztit = 'after convect'         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
775         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        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, &  
             fs_bound, fq_bound)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *,"aprescon = ", za  
        zx_t = 0.0  
        za = 0.0  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *,"Precip = ", zx_t  
     ENDIF  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_apres(i) = 0.0  
        ENDDO  
        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  
776         DO k = 1, llm         DO k = 1, llm
777            DO i = 1, klon            DO i = 1, klon
778               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 1290  contains Line 781  contains
781            ENDDO            ENDDO
782         ENDDO         ENDDO
783      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
784    
785      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
786    
787      d_t_ajs = 0.      d_t_ajs = 0.
788      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1307  contains Line 797  contains
797         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
798         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
799      else      else
        ! Thermiques  
800         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
801              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
802      endif      endif
803    
     IF (if_ebil >= 2) THEN  
        ztit = 'after dry_adjust'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
804      ! Caclul des ratqs      ! Caclul des ratqs
805    
806      ! 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
807      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
808      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
809         do k = 1, llm         do k = 1, llm
810            do i = 1, klon            do i = 1, klon
811               if(ptconv(i, k)) then               if(ptconv(i, k)) then
812                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
813                       +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)
814               else               else
815                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
816               endif               endif
# Line 1339  contains Line 821  contains
821      ! ratqs stables      ! ratqs stables
822      do k = 1, llm      do k = 1, llm
823         do i = 1, klon         do i = 1, klon
824            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
825                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
826         enddo         enddo
827      enddo      enddo
828    
829      ! ratqs final      ! ratqs final
830      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
831         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
832         ! ratqs final         ! ratqs final
833         ! 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
834         ! relaxation des ratqs         ! relaxation des ratqs
835         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
836         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
837      else      else
838         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
839         ratqs = ratqss         ratqs = ratqss
840      endif      endif
841    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
842      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
843           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, &
844           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1376  contains Line 855  contains
855            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
856         ENDDO         ENDDO
857      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *,"apresilp = ", za  
        zx_t = 0.0  
        za = 0.0  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *,"Precip = ", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        ztit = 'after fisrt'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        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, &  
             fs_bound, fq_bound)  
     END IF  
858    
859      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
860    
861      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
862    
863      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= - 1) THEN
864           ! seulement pour Tiedtke
865         snow_tiedtke = 0.         snow_tiedtke = 0.
866         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
867            rain_tiedtke = rain_con            rain_tiedtke = rain_con
868         else         else
869            rain_tiedtke = 0.            rain_tiedtke = 0.
870            do k = 1, llm            do k = 1, llm
871               do i = 1, klon               do i = 1, klon
872                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
873                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
874                          *zmasse(i, k)                          * zmasse(i, k)
875                  endif                  endif
876               enddo               enddo
877            enddo            enddo
878         endif         endif
879    
880         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
881         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
882              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
883         DO k = 1, llm         DO k = 1, llm
884            DO i = 1, klon            DO i = 1, klon
885               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1433  contains Line 889  contains
889            ENDDO            ENDDO
890         ENDDO         ENDDO
891      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
892         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
893         ! 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
894         ! facttemps         ! d'un facteur facttemps.
895         facteur = dtphys *facttemps         facteur = dtphys * facttemps
896         do k = 1, llm         do k = 1, llm
897            do i = 1, klon            do i = 1, klon
898               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
899               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
900                    then                    > rnebcon(i, k) * clwcon(i, k)) then
901                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
902                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
903               endif               endif
# Line 1450  contains Line 906  contains
906    
907         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
908         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
909         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
910      ENDIF      ENDIF
911    
912      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1468  contains Line 924  contains
924      ENDIF      ENDIF
925    
926      ! Precipitation totale      ! Precipitation totale
   
927      DO i = 1, klon      DO i = 1, klon
928         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
929         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
930      ENDDO      ENDDO
931    
932      IF (if_ebil >= 2) THEN      ! Humidit\'e relative pour diagnostic :
        ztit = "after diagcld"  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
     ! Humidité relative pour diagnostic:  
933      DO k = 1, llm      DO k = 1, llm
934         DO i = 1, klon         DO i = 1, klon
935            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
936            IF (thermcep) THEN            IF (thermcep) THEN
937               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)  
938               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
939               zcor = 1./(1.-retv*zx_qs)               zcor = 1. / (1. - retv * zx_qs)
940               zx_qs = zx_qs*zcor               zx_qs = zx_qs * zcor
941            ELSE            ELSE
942               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
943                  zx_qs = qsats(zx_t)/play(i, k)                  zx_qs = qsats(zx_t) / play(i, k)
944               ELSE               ELSE
945                  zx_qs = qsatl(zx_t)/play(i, k)                  zx_qs = qsatl(zx_t) / play(i, k)
946               ENDIF               ENDIF
947            ENDIF            ENDIF
948            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
949            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
950         ENDDO         ENDDO
951      ENDDO      ENDDO
952    
953      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
954      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      tau_ae = 0.
955      IF (ok_ade .OR. ok_aie) THEN      piz_ae = 0.
956         ! Get sulfate aerosol distribution      cg_ae = 0.
        CALL readsulfate(rdayvrai, firstcal, sulfate)  
        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)  
   
        ! Calculate aerosol optical properties (Olivier Boucher)  
        CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &  
             aerindex)  
     ELSE  
        tau_ae = 0.  
        piz_ae = 0.  
        cg_ae = 0.  
     ENDIF  
957    
958      ! Paramètres optiques des nuages et quelques paramètres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
959      ! diagnostics :      ! diagnostics :
960      if (ok_newmicro) then      if (ok_newmicro) then
961         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
962              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
963              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
964      else      else
965         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
966              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
967              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
968      endif      endif
969    
970      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
971      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
972         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
973            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
974                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
975                 + falbe(i, is_ter) * pctsrf(i, is_ter) &         ! Rayonnement (compatible Arpege-IFS) :
976                 + falbe(i, is_sic) * pctsrf(i, is_sic)         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
977            albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
978                 + falblw(i, is_lic) * pctsrf(i, is_lic) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
979                 + falblw(i, is_ter) * pctsrf(i, is_ter) &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
980                 + falblw(i, is_sic) * pctsrf(i, is_sic)              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
981         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  
982      ENDIF      ENDIF
     itaprad = itaprad + 1  
983    
984      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
985    
986      DO k = 1, llm      DO k = 1, llm
987         DO i = 1, klon         DO i = 1, klon
988            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
989                   / 86400.
990         ENDDO         ENDDO
991      ENDDO      ENDDO
992    
     IF (if_ebil >= 2) THEN  
        ztit = 'after rad'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        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, &  
             fs_bound, fq_bound)  
     END IF  
   
993      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
994      DO i = 1, klon      DO i = 1, klon
995         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
996         zxsnow(i) = 0.0         zxsnow(i) = 0.
997      ENDDO      ENDDO
998      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
999         DO i = 1, klon         DO i = 1, klon
1000            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf) * pctsrf(i, nsrf)
1001            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf) * pctsrf(i, nsrf)
1002         ENDDO         ENDDO
1003      ENDDO      ENDDO
1004    
1005      ! 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)
1006    
1007      DO i = 1, klon      DO i = 1, klon
1008         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1009      ENDDO      ENDDO
1010    
1011      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1012    
1013      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1014         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1015         igwd = 0         igwd = 0
1016         DO i = 1, klon         DO i = 1, klon
1017            itest(i) = 0            itest(i) = 0
1018            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1019               itest(i) = 1               itest(i) = 1
1020               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1021            ENDIF            ENDIF
1022         ENDDO         ENDDO
1023    
1024         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1025              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1026              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1027    
1028         ! ajout des tendances         ! ajout des tendances
1029         DO k = 1, llm         DO k = 1, llm
# Line 1620  contains Line 1036  contains
1036      ENDIF      ENDIF
1037    
1038      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1039         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1040         igwd = 0         igwd = 0
1041         DO i = 1, klon         DO i = 1, klon
1042            itest(i) = 0            itest(i) = 0
1043            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1044               itest(i) = 1               itest(i) = 1
1045               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1046            ENDIF            ENDIF
1047         ENDDO         ENDDO
1048    
# Line 1645  contains Line 1060  contains
1060         ENDDO         ENDDO
1061      ENDIF      ENDIF
1062    
1063      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
1064    
1065      DO i = 1, klon      DO i = 1, klon
1066         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1653  contains Line 1068  contains
1068      ENDDO      ENDDO
1069      DO k = 1, llm      DO k = 1, llm
1070         DO i = 1, klon         DO i = 1, klon
1071            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 &
1072            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1073              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1074                   * zmasse(i, k)
1075         ENDDO         ENDDO
1076      ENDDO      ENDDO
1077    
1078      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1079             zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &  
          aam, torsfc)  
   
     IF (if_ebil >= 2) THEN  
        ztit = 'after orography'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1080    
1081      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1082      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1083           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
1084           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1085           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           zmasse, ncid_startphy)
1086           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &  
1087           tr_seri, zmasse)      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1088             pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1089      IF (offline) THEN           frac_impa, frac_nucl, pphis, airephy, dtphys)
        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  
1090    
1091      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1092      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
1093    
1094      ! diag. bilKP      ! diag. bilKP
1095    
1096      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
1097           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1098    
1099      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1100    
1101      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1102      DO k = 1, llm      DO k = 1, llm
1103         DO i = 1, klon         DO i = 1, klon
1104            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1707  contains Line 1109  contains
1109         END DO         END DO
1110      END DO      END DO
1111    
     IF (if_ebil >= 1) THEN  
        ztit = 'after physic'  
        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        ! Comme les tendances de la physique sont ajoute dans la dynamique,  
        ! on devrait avoir que la variation d'entalpie par la dynamique  
        ! est egale a la variation de la physique au pas de temps precedent.  
        ! Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &  
             evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
   
        d_h_vcol_phy = d_h_vcol  
   
     END IF  
   
1112      ! SORTIES      ! SORTIES
1113    
1114      !cc prw = eau precipitable      ! prw = eau precipitable
1115      DO i = 1, klon      DO i = 1, klon
1116         prw(i) = 0.         prw(i) = 0.
1117         DO k = 1, llm         DO k = 1, llm
1118            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1119         ENDDO         ENDDO
1120      ENDDO      ENDDO
1121    
# Line 1746  contains Line 1131  contains
1131         ENDDO         ENDDO
1132      ENDDO      ENDDO
1133    
1134      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1135         DO iq = 3, nqmx         DO k = 1, llm
1136            DO k = 1, llm            DO i = 1, klon
1137               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  
1138            ENDDO            ENDDO
1139         ENDDO         ENDDO
1140      ENDIF      ENDDO
1141    
1142      ! 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:
1143      DO k = 1, llm      DO k = 1, llm
# Line 1764  contains Line 1147  contains
1147         ENDDO         ENDDO
1148      ENDDO      ENDDO
1149    
1150      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1151      call write_histhf      CALL histwrite_phy("aire", airephy)
1152      call write_histday      CALL histwrite_phy("psol", paprs(:, 1))
1153      call write_histins      CALL histwrite_phy("precip", rain_fall + snow_fall)
1154        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1155      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("pluc", rain_con + snow_con)
1156      IF (lafin) THEN      CALL histwrite_phy("tsol", ztsol)
1157         itau_phy = itau_phy + itap      CALL histwrite_phy("t2m", zt2m)
1158         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("q2m", zq2m)
1159              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("u10m", zu10m)
1160              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &      CALL histwrite_phy("v10m", zv10m)
1161              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("snow", snow_fall)
1162              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)      CALL histwrite_phy("cdrm", cdragm)
1163      ENDIF      CALL histwrite_phy("cdrh", cdragh)
1164        CALL histwrite_phy("topl", toplw)
1165      firstcal = .FALSE.      CALL histwrite_phy("evap", evap)
1166        CALL histwrite_phy("sols", solsw)
1167    contains      CALL histwrite_phy("soll", sollw)
1168        CALL histwrite_phy("solldown", sollwdown)
1169      subroutine write_histday      CALL histwrite_phy("bils", bils)
1170        CALL histwrite_phy("sens", - sens)
1171        use gr_phy_write_3d_m, only: gr_phy_write_3d      CALL histwrite_phy("fder", fder)
1172        integer itau_w ! pas de temps ecriture      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1173        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1174        !------------------------------------------------      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1175        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       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  
   
     !***************************************************************  
   
     subroutine write_histins  
   
       ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09  
1176    
1177        real zout      DO nsrf = 1, nbsrf
1178        integer itau_w ! pas de temps ecriture         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1179           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1180        !--------------------------------------------------         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1181           CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1182        IF (ok_instan) THEN         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1183           ! Champs 2D:         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1184           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1185           zsto = dtphys * ecrit_ins         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1186           zout = dtphys * ecrit_ins         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1187           itau_w = itau_phy + itap      END DO
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)  
          CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)  
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)  
          CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = paprs(i, 1)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)  
          !ccIM  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon) = -1*sens(1:klon)  
          ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
   
          DO nsrf = 1, nbsrf  
             !XXX  
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
          END DO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)  
   
          !HBTM2  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
   
          if (ok_sync) then  
             call histsync(nid_ins)  
          endif  
       ENDIF  
   
     end subroutine write_histins  
   
     !****************************************************  
   
     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  
1188    
1189        if (ok_sync) then      CALL histwrite_phy("albs", albsol)
1190           call histsync(nid_hf3d)      CALL histwrite_phy("rugs", zxrugs)
1191        endif      CALL histwrite_phy("s_pblh", s_pblh)
1192        CALL histwrite_phy("s_pblt", s_pblt)
1193        CALL histwrite_phy("s_lcl", s_lcl)
1194        CALL histwrite_phy("s_capCL", s_capCL)
1195        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1196        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1197        CALL histwrite_phy("s_therm", s_therm)
1198        CALL histwrite_phy("s_trmb1", s_trmb1)
1199        CALL histwrite_phy("s_trmb2", s_trmb2)
1200        CALL histwrite_phy("s_trmb3", s_trmb3)
1201    
1202        if (conv_emanuel) then
1203           CALL histwrite_phy("ptop", ema_pct)
1204           CALL histwrite_phy("dnwd0", - mp)
1205        end if
1206    
1207        CALL histwrite_phy("temp", t_seri)
1208        CALL histwrite_phy("vitu", u_seri)
1209        CALL histwrite_phy("vitv", v_seri)
1210        CALL histwrite_phy("geop", zphi)
1211        CALL histwrite_phy("pres", play)
1212        CALL histwrite_phy("dtvdf", d_t_vdf)
1213        CALL histwrite_phy("dqvdf", d_q_vdf)
1214        CALL histwrite_phy("rhum", zx_rh)
1215    
1216        if (ok_instan) call histsync(nid_ins)
1217    
1218        IF (lafin) then
1219           call NF95_CLOSE(ncid_startphy)
1220           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1221                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1222                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1223                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1224                w01)
1225        end IF
1226    
1227      end subroutine write_histhf3d      firstcal = .FALSE.
1228    
1229    END SUBROUTINE physiq    END SUBROUTINE physiq
1230    

Legend:
Removed from v.54  
changed lines
  Added in v.206

  ViewVC Help
Powered by ViewVC 1.1.21