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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC trunk/Sources/phylmd/physiq.f revision 225 by guez, Mon Oct 16 12:35:41 2017 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: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
          ok_orodr, ok_orolf, soil_model  
24      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
25      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use clouds_gno_m, only: clouds_gno
26        use comconst, only: dtphys
27        USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31        use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
34      use diagetpq_m, only: diagetpq      USE dimens_m, ONLY: llm, nqmx
35      USE dimens_m, ONLY: iim, jjm, llm, nqmx      USE dimphy, ONLY: klon
     USE dimphy, ONLY: klon, nbtr  
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      use dynetat0_m, only: day_ref, annee_ref
39        USE fcttre, ONLY: foeew
40        use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histcom, ONLY: histsync      USE histsync_m, ONLY: histsync
43      USE histwrite_m, ONLY: histwrite      USE histwrite_phy_m, ONLY: histwrite_phy
44      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45           nbsrf           nbsrf
46      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histins_m, ONLY: ini_histins, nid_ins
47      USE ini_histday_m, ONLY: ini_histday      use netcdf95, only: NF95_CLOSE
48      USE ini_histins_m, ONLY: ini_histins      use newmicro_m, only: newmicro
49      USE oasis_m, ONLY: ok_oasis      use nr_util, only: assert
50      USE orbite_m, ONLY: orbite, zenang      use nuage_m, only: nuage
51        USE orbite_m, ONLY: orbite
52      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
53      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
54      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
55      USE phystokenc_m, ONLY: phystokenc      USE phyredem0_m, ONLY: phyredem0
56      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
57      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
58      use sugwd_m, only: sugwd      use yoegwd, only: sugwd
59      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
60      USE temps, ONLY: annee_ref, day_ref, itau_phy      use time_phylmdz, only: itap, increment_itap
61        use transp_m, only: transp
62        use transp_lay_m, only: transp_lay
63        use unit_nml_m, only: unit_nml
64        USE ymds2ju_m, ONLY: ymds2ju
65      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
66        use zenang_m, only: zenang
67    
     ! 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)  
68      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
69    
70      REAL, intent(in):: paprs(klon, llm + 1)      integer, intent(in):: dayvrai
71      ! (pression pour chaque inter-couche, en Pa)      ! current day number, based at value 1 on January 1st of annee_ref
72    
73      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))  
74    
75      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! pression pour chaque inter-couche, en Pa
77    
78      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: play(:, :) ! (klon, llm)
79        ! pression pour le mileu de chaque couche (en Pa)
80    
81      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82      ! vitesse dans la direction X (de O a E) en m/s      ! géopotentiel de chaque couche (référence sol)
83    
84      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)  
85    
86      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: u(:, :) ! (klon, llm)
87      ! (humidité spécifique et fractions massiques des autres traceurs)      ! vitesse dans la direction X (de O a E) en m / s
88    
89      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
90      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  
91    
92      LOGICAL:: firstcal = .true.      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93        ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      INTEGER nbteta      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
96      PARAMETER(nbteta = 3)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
97        REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
98        REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
99    
100      REAL PVteta(klon, nbteta)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101      ! (output vorticite potentielle a des thetas constantes)      ! tendance physique de "qx" (s-1)
102    
103      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.)  
104    
105      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL:: firstcal = .true.
     PARAMETER (check = .FALSE.)  
106    
107      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
108      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
109    
110      ! 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  
111      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
112      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
113      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
114    
115      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
116      PARAMETER (ivap = 1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq = 2)  
117    
118      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
119      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
120    
121      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
122      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)
123    
124      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
125    
126      !IM Amip2 PV a theta constante      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
127        REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
128    
129      CHARACTER(LEN = 3) ctetaSTD(nbteta)      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
130      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 '/  
131    
132      ! prw: precipitable water      ! prw: precipitable water
133      real prw(klon)      real prw(klon)
134    
135      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
136      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
137      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
138      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
139    
     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  
   
140      ! Variables propres a la physique      ! Variables propres a la physique
141    
142      INTEGER, save:: radpas      INTEGER, save:: radpas
143      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
144      ! "physiq".)      ! "physiq".
   
     REAL radsol(klon)  
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
   
     INTEGER, SAVE:: itap ! number of calls to "physiq"  
145    
146        REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
147      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
148    
149      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
150      ! soil temperature of surface fraction      ! soil temperature of surface fraction
151    
152      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
153      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
   
     REAL fqsurf(klon, nbsrf)  
     SAVE fqsurf ! humidite de l'air au contact de la surface  
154    
155      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: fqsurf(klon, nbsrf)
156        ! humidite de l'air au contact de la surface
157    
158      REAL fsnow(klon, nbsrf)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
159      SAVE fsnow ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
160        REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
161    
162      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) :  
163      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
164      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
165      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 294  contains Line 168  contains
168      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
169      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
170      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
171      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
172        INTEGER igwd, itest(klon)
173    
174      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
175        REAL, save:: run_off_lic_0(klon)
176    
177      REAL agesno(klon, nbsrf)      ! Variables li\'ees \`a la convection d'Emanuel :
178      SAVE agesno ! age de la neige      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
179        REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
180        REAL, save:: sig1(klon, llm), w01(klon, llm)
181    
182      REAL run_off_lic_0(klon)      ! Variables pour la couche limite (Alain Lahellec) :
183      SAVE run_off_lic_0      REAL cdragh(klon) ! drag coefficient pour T and Q
184      !KE43      REAL cdragm(klon) ! drag coefficient pour vent
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
185    
186      REAL Ma(klon, llm) ! undilute upward mass flux      ! Pour phytrac :
187      SAVE Ma      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
188      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL yu1(klon), yv1(klon) ! vent dans la premi\`ere couche
     SAVE qcondc  
     REAL ema_work1(klon, llm), ema_work2(klon, llm)  
     SAVE ema_work1, ema_work2  
189    
190      REAL wd(klon) ! sb      REAL, save:: ffonte(klon, nbsrf)
191      SAVE wd ! sb      ! flux thermique utilise pour fondre la neige
192    
193      ! Variables locales pour la couche limite (al1):      REAL, save:: fqcalving(klon, nbsrf)
194        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
195        ! hauteur de neige, en kg / m2 / s
196    
197      ! Variables locales:      REAL zxffonte(klon), zxfqcalving(klon)
198    
199      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
200      REAL cdragm(klon) ! drag coefficient pour vent      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
201    
202      !AA Pour phytrac      REAL, save:: pfrac_1nucl(klon, llm)
203      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      ! Produits des coefs lessi nucl (alpha = 1)
     REAL yu1(klon) ! vents dans la premiere couche U  
     REAL yv1(klon) ! vents dans la premiere couche V  
     REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
     REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface  
     ! !et necessaire pour limiter la  
     ! !hauteur de neige, en kg/m2/s  
     REAL zxffonte(klon), zxfqcalving(klon)  
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
     save pfrac_impa  
     REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
     save pfrac_nucl  
     REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)  
     save pfrac_1nucl  
     REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
206      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
207    
208      !AA      REAL, save:: rain_fall(klon)
209      REAL rain_fall(klon) ! pluie      ! liquid water mass flux (kg / m2 / s), positive down
210      REAL snow_fall(klon) ! neige  
211      save snow_fall, rain_fall      REAL, save:: snow_fall(klon)
212      !IM cf FH pour Tiedtke 080604      ! solid water mass flux (kg / m2 / s), positive down
213    
214      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
215    
216      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon) ! flux d'\'evaporation au sol
217      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
218      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
219      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
220        REAL, save:: dlw(klon) ! derivative of infra-red flux
221      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
222      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
     save fder  
223      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
224      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
225      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
226      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
227    
228      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
229      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
230    
231      ! Conditions aux limites      ! Conditions aux limites
232    
233      INTEGER julien      INTEGER julien
234        REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
235      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
     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  
   
236      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
237        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
238    
239      ! Declaration des procedures appelees      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
240        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  
241    
242      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
243      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 411  contains Line 247  contains
247      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
248      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
249    
250      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
251      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
252      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
253      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)  
254    
255      ! 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
256      ! que les variables soient rémanentes      ! les variables soient r\'emanentes.
257      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
258      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
259      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
260      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
261      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
262      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
263      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      real, save:: sollwdown(klon) ! downward LW flux at surface
264      REAL albpla(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
265      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL, save:: albpla(klon)
266      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
267      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
268      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
269        REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
270      INTEGER itaprad      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
271      SAVE itaprad  
272        REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
273      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
274      REAL conv_t(klon, llm) ! convergence of temperature (K/s)  
275        REAL zxfluxlat(klon)
276      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL dist, mu0(klon), fract(klon)
277      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      real longi
   
     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  
   
278      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
279      LOGICAL zx_ajustq      REAL zb
280        REAL zx_t, zx_qs, zcor
     REAL za, zb  
     REAL zx_t, zx_qs, zdelta, zcor  
281      real zqsat(klon, llm)      real zqsat(klon, llm)
282      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL t_coup  
     PARAMETER (t_coup = 234.0)  
   
283      REAL zphi(klon, llm)      REAL zphi(klon, llm)
284    
285      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
286    
287      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
288      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
289      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
290      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
291      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
292      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
293      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
294      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
295      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
296      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
297      ! Grdeurs de sorties      ! Grandeurs de sorties
298      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
299      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
300      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
301      REAL s_trmb3(klon)      REAL s_trmb3(klon)
302    
303      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables pour la convection de K. Emanuel :
304    
305      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
306      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
307      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
308      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  
309      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)  
310    
311      ! Variables du changement      ! Variables du changement
312    
313      ! con: convection      ! con: convection
314      ! lsc: large scale condensation      ! lsc: large scale condensation
315      ! ajs: ajustement sec      ! ajs: ajustement sec
316      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
317      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
318      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
319      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
320      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)
321      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
322      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
323      REAL rneb(klon, llm)      REAL rneb(klon, llm)
324    
325      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
326      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
327      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
328      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
329      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
330      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
331    
332      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
333        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
334    
335      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
336      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
337      REAL d_ts(klon, nbsrf)      REAL, save:: snow_con(klon) ! neige (mm / s)
338        real snow_lsc(klon)
339        REAL d_ts(klon, nbsrf) ! variation of ftsol
340    
341      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
342      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 536  contains Line 346  contains
346      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
347      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
348    
349      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
350      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
351      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
352    
353      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
354      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
355      real, save:: facttemps      real:: facttemps = 1.e-4
356      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
357      real facteur      real facteur
358    
359      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
360      logical ptconv(klon, llm)      logical ptconv(klon, llm)
361    
362      ! Variables locales pour effectuer les appels en série :      ! Variables pour effectuer les appels en s\'erie :
363    
364      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
365      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
366      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
367        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
368    
369      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
370    
# Line 568  contains Line 373  contains
373      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
374      REAL aam, torsfc      REAL aam, torsfc
375    
     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  
   
376      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.
377      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.
378      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.
379      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.
380    
     REAL zsto  
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
381      real date0      real date0
382        REAL tsol(klon)
383    
384        REAL d_t_ec(klon, llm)
385        ! tendance due \`a la conversion d'\'energie cin\'etique en
386        ! énergie thermique
387    
388        REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
389        ! temperature and humidity at 2 m
390    
391        REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
392        ! composantes du vent \`a 10 m
393        
394        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
395        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
396    
397      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Aerosol effects:
     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  
   
     REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique  
     REAL ZRCPD  
   
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m  
     REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille  
     !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
     REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]  
   
     REAL, save:: sulfate_pi(klon, llm)  
     ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)  
   
     REAL cldtaupi(klon, llm)  
     ! (Cloud optical thickness for pre-industrial (pi) aerosols)  
   
     REAL re(klon, llm) ! Cloud droplet effective radius  
     REAL fl(klon, llm) ! denominator of re  
   
     ! Aerosol optical properties  
     REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade = True -ADE = topswad-topsw  
   
     REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.  
     ! ok_aie = True ->  
     ! ok_ade = True -AIE = topswai-topswad  
     ! ok_ade = F -AIE = topswai-topsw  
   
     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  
398    
399      real zmasse(klon, llm)      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
400        LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
401    
402        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
403        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
404        ! B). They link cloud droplet number concentration to aerosol mass
405        ! concentration.
406    
407        real zmasse(klon, llm)
408      ! (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)
409    
410      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
411    
412        namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
413             ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
414             nsplit_thermals
415    
416      !----------------------------------------------------------------      !----------------------------------------------------------------
417    
418      modname = 'physiq'      IF (nqmx < 2) CALL abort_gcm('physiq', &
419      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  
420    
421      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
422         ! initialiser         ! initialiser
423         u10m = 0.         u10m_srf = 0.
424         v10m = 0.         v10m_srf = 0.
425         t2m = 0.         t2m = 0.
426         q2m = 0.         q2m = 0.
427         ffonte = 0.         ffonte = 0.
428         fqcalving = 0.         fqcalving = 0.
429         piz_ae = 0.         rain_con = 0.
430         tau_ae = 0.         snow_con = 0.
431         cg_ae = 0.         d_u_con = 0.
432         rain_con(:) = 0.         d_v_con = 0.
433         snow_con(:) = 0.         rnebcon0 = 0.
434         bl95_b0 = 0.         clwcon0 = 0.
435         bl95_b1 = 0.         rnebcon = 0.
436         topswai(:) = 0.         clwcon = 0.
        topswad(:) = 0.  
        solswai(:) = 0.  
        solswad(:) = 0.  
   
        d_u_con = 0.0  
        d_v_con = 0.0  
        rnebcon0 = 0.0  
        clwcon0 = 0.0  
        rnebcon = 0.0  
        clwcon = 0.0  
   
437         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
438         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
439         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
440         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
441         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
442         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
443         therm =0.         therm =0.
444         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
445         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
446         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
447    
448         IF (if_ebil >= 1) d_h_vcol_phy = 0.         iflag_thermals = 0
449           nsplit_thermals = 1
450           print *, "Enter namelist 'physiq_nml'."
451           read(unit=*, nml=physiq_nml)
452           write(unit_nml, nml=physiq_nml)
453    
454         ! appel a la lecture du run.def physique         call conf_phys
   
        call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &  
             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)  
455    
456         ! Initialiser les compteurs:         ! Initialiser les compteurs:
457    
458         frugs = 0.         frugs = 0.
459         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
460         itaprad = 0              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
461         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
462              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
463              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)  
464    
465         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
466         q2 = 1.e-8         q2 = 1e-8
467    
468         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = lmt_pas / nbapp_rad
469           print *, "radpas = ", radpas
        ! 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  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message = 'Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        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  
470    
471           ! Initialisation pour le sch\'ema de convection d'Emanuel :
472           IF (conv_emanuel) THEN
473              ibas_con = 1
474              itop_con = 1
475         ENDIF         ENDIF
476    
477         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 782  contains Line 481  contains
481            rugoro = 0.            rugoro = 0.
482         ENDIF         ENDIF
483    
484         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  
485    
486         ! Initialisation des sorties         ! Initialisation des sorties
487    
488         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histins(dtphys, ok_newmicro)
489         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
490         call ini_histins(dtphys, ok_instan, nid_ins)         ! Positionner date0 pour initialisation de ORCHIDEE
491         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         print *, 'physiq date0: ', date0
492         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         CALL phyredem0
        WRITE(*, *) 'physiq date0: ', date0  
493      ENDIF test_firstcal      ENDIF test_firstcal
494    
495      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
496        ! u, v, t, qx:
497        t_seri = t
498        u_seri = u
499        v_seri = v
500        q_seri = qx(:, :, ivap)
501        ql_seri = qx(:, :, iliq)
502        tr_seri = qx(:, :, 3:nqmx)
503    
504      DO i = 1, klon      tsol = sum(ftsol * pctsrf, dim = 2)
        d_ps(i) = 0.0  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
     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  
   
     IF (if_ebil >= 1) THEN  
        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  
505    
506      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
507      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 877  contains Line 514  contains
514      ELSE      ELSE
515         DO k = 1, llm         DO k = 1, llm
516            DO i = 1, klon            DO i = 1, klon
517               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
518               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
519            ENDDO            ENDDO
520         ENDDO         ENDDO
521         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 894  contains Line 531  contains
531      ! Check temperatures:      ! Check temperatures:
532      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
533    
534      ! Incrementer le compteur de la physique      call increment_itap
535      itap = itap + 1      julien = MOD(dayvrai, 360)
     julien = MOD(NINT(rdayvrai), 360)  
536      if (julien == 0) julien = 360      if (julien == 0) julien = 360
537    
538      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
539    
540      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! \'Evaporation de l'eau liquide nuageuse :
   
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
     if (nqmx >= 5) then  
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Évaporation de l'eau liquide nuageuse :  
541      DO k = 1, llm      DO k = 1, llm
542         DO i = 1, klon         DO i = 1, klon
543            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 921  contains Line 548  contains
548      ENDDO      ENDDO
549      ql_seri = 0.      ql_seri = 0.
550    
551      IF (if_ebil >= 2) THEN      frugs = MAX(frugs, 0.000015)
552         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)  
   
     END IF  
   
     ! Appeler la diffusion verticale (programme de couche limite)  
   
     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  
553    
554      ! calculs necessaires au calcul de l'albedo dans l'interface      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
555        ! la surface.
556    
557      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
558      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
559         zdtime = dtphys * REAL(radpas)      albsol = sum(falbe * pctsrf, dim = 2)
560         CALL zenang(zlongi, time, zdtime, rmu0, fract)  
561      ELSE      ! R\'epartition sous maille des flux longwave et shortwave
562         rmu0 = -999.999      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
563      ENDIF  
564        forall (nsrf = 1: nbsrf)
565      ! Calcul de l'abedo moyen par maille         fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
566      albsol(:) = 0.              * (tsol - ftsol(:, nsrf))
567      albsollw(:) = 0.         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
568      DO nsrf = 1, nbsrf      END forall
569         DO i = 1, klon  
570            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
571            albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
572         ENDDO           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
573      ENDDO           snow_fall, fsolsw, fsollw, frugs, agesno, rugoro, d_t_vdf, d_q_vdf, &
574             d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, &
575      ! Repartition sous maille des flux LW et SW           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m_srf, &
576      ! Repartition du longwave par sous-surface linearisee           v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
577             trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
578      DO nsrf = 1, nbsrf  
579         DO i = 1, klon      ! Incr\'ementation des flux
580            fsollw(i, nsrf) = sollw(i) &  
581                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))      sens = - sum(flux_t * pctsrf, dim = 2)
582            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))      evap = - sum(flux_q * pctsrf, dim = 2)
583         ENDDO      fder = dlw + dsens + devap
     ENDDO  
   
     fder = dlw  
   
     ! Couche limite:  
   
     CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &  
          u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &  
          ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &  
          qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &  
          rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &  
          cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &  
          d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &  
          cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
          pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &  
          fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)  
   
     ! Incrémentation des flux  
   
     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  
584    
585      DO k = 1, llm      DO k = 1, llm
586         DO i = 1, klon         DO i = 1, klon
# Line 1029  contains Line 591  contains
591         ENDDO         ENDDO
592      ENDDO      ENDDO
593    
     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  
   
594      ! Update surface temperature:      ! Update surface temperature:
595    
596      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
597         zxtsol(i) = 0.0      ftsol = ftsol + d_ts
598         zxfluxlat(i) = 0.0      tsol = sum(ftsol * pctsrf, dim = 2)
599        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
600         zt2m(i) = 0.0      zt2m = sum(t2m * pctsrf, dim = 2)
601         zq2m(i) = 0.0      zq2m = sum(q2m * pctsrf, dim = 2)
602         zu10m(i) = 0.0      u10m = sum(u10m_srf * pctsrf, dim = 2)
603         zv10m(i) = 0.0      v10m = sum(v10m_srf * pctsrf, dim = 2)
604         zxffonte(i) = 0.0      zxffonte = sum(ffonte * pctsrf, dim = 2)
605         zxfqcalving(i) = 0.0      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
606        s_pblh = sum(pblh * pctsrf, dim = 2)
607         s_pblh(i) = 0.0      s_lcl = sum(plcl * pctsrf, dim = 2)
608         s_lcl(i) = 0.0      s_capCL = sum(capCL * pctsrf, dim = 2)
609         s_capCL(i) = 0.0      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
610         s_oliqCL(i) = 0.0      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
611         s_cteiCL(i) = 0.0      s_pblT = sum(pblT * pctsrf, dim = 2)
612         s_pblT(i) = 0.0      s_therm = sum(therm * pctsrf, dim = 2)
613         s_therm(i) = 0.0      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
614         s_trmb1(i) = 0.0      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
615         s_trmb2(i) = 0.0      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
        s_trmb3(i) = 0.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  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)  
           zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(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)  
           zxfqcalving(i) = zxfqcalving(i) + &  
                fqcalving(i, nsrf)*pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne  
616    
617        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
618      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
619         DO i = 1, klon         DO i = 1, klon
620            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
621                 ftsol(i, nsrf) = tsol(i)
622            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
623            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
624            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
625            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
626            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
627            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
628                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
629            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
630            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
631            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
632            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
633            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
634            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
635            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
636            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
637            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
638            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
639         ENDDO         ENDDO
640      ENDDO      ENDDO
641    
642      ! Calculer la derive du flux infrarouge      dlw = - 4. * RSIGMA * tsol**3
643    
644      DO i = 1, klon      ! Appeler la convection
645         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3  
646      ENDDO      if (conv_emanuel) then
647           CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
648      ! Appeler la convection (au choix)              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
649                upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
650      DO k = 1, llm         snow_con = 0.
651         DO i = 1, klon         clwcon0 = qcondc
652            conv_q(i, k) = d_q_dyn(i, k) &         mfu = upwd + dnwd
653                 + d_q_vdf(i, k)/dtphys  
654            conv_t(i, k) = d_t_dyn(i, k) &         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
655                 + d_t_vdf(i, k)/dtphys         zqsat = zqsat / (1. - retv * zqsat)
656         ENDDO  
657      ENDDO         ! Properties of convective clouds
658      IF (check) THEN         clwcon0 = fact_cldcon * clwcon0
659         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
660         print *, "avantcon = ", za              rnebcon0)
661      ENDIF  
662      zx_ajustq = .FALSE.         forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
663      IF (iflag_con == 2) zx_ajustq = .TRUE.         mfd = 0.
664      IF (zx_ajustq) THEN         pen_u = 0.
665         DO i = 1, klon         pen_d = 0.
666            z_avant(i) = 0.0         pde_d = 0.
667         ENDDO         pde_u = 0.
668         DO k = 1, llm      else
669            DO i = 1, klon         conv_q = d_q_dyn + d_q_vdf / dtphys
670               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &         conv_t = d_t_dyn + d_t_vdf / dtphys
671                    *zmasse(i, k)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
672            ENDDO         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
673         ENDDO              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
674      ENDIF              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
675                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
676      select case (iflag_con)              kdtop, pmflxr, pmflxs)
     case (1)  
        print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'  
        stop 1  
     case (2)  
        CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &  
             zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &  
             pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &  
             pmflxs)  
677         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
678         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
679         DO i = 1, klon         ibas_con = llm + 1 - kcbot
680            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
681            itop_con(i) = llm + 1 - kctop(i)      END if
        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  
        ELSE  
           ! conema3 ne contient pas les traceurs  
           CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &  
                tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &  
                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)  
        ENDIF  
   
        IF (.NOT. ok_gust) THEN  
           do i = 1, klon  
              wd(i) = 0.0  
           enddo  
        ENDIF  
   
        ! Calcul des propriétés des nuages convectifs  
   
        DO k = 1, llm  
           DO i = 1, klon  
              zx_t = t_seri(i, k)  
              IF (thermcep) THEN  
                 zdelta = MAX(0., SIGN(1., rtt-zx_t))  
                 zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)  
                 zx_qs = MIN(0.5, zx_qs)  
                 zcor = 1./(1.-retv*zx_qs)  
                 zx_qs = zx_qs*zcor  
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/play(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/play(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k) = zx_qs  
           ENDDO  
        ENDDO  
   
        ! 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  
682    
683      DO k = 1, llm      DO k = 1, llm
684         DO i = 1, klon         DO i = 1, klon
# Line 1245  contains Line 689  contains
689         ENDDO         ENDDO
690      ENDDO      ENDDO
691    
692      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
693         ztit = 'after convect'         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
694         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  
695         DO k = 1, llm         DO k = 1, llm
696            DO i = 1, klon            DO i = 1, klon
697               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 700  contains
700            ENDDO            ENDDO
701         ENDDO         ENDDO
702      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
703    
704      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
705    
706      d_t_ajs = 0.      d_t_ajs = 0.
707      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1307  contains Line 716  contains
716         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
717         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
718      else      else
        ! Thermiques  
719         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
720              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)
721      endif      endif
722    
     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  
   
723      ! Caclul des ratqs      ! Caclul des ratqs
724    
725      ! 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
726      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
727      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
728         do k = 1, llm         do k = 1, llm
729            do i = 1, klon            do i = 1, klon
730               if(ptconv(i, k)) then               if(ptconv(i, k)) then
731                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
732                       +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)
733               else               else
734                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
735               endif               endif
# Line 1339  contains Line 740  contains
740      ! ratqs stables      ! ratqs stables
741      do k = 1, llm      do k = 1, llm
742         do i = 1, klon         do i = 1, klon
743            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
744                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
745         enddo         enddo
746      enddo      enddo
747    
748      ! ratqs final      ! ratqs final
749      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
750         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
751         ! ratqs final         ! ratqs final
752         ! 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
753         ! relaxation des ratqs         ! relaxation des ratqs
754         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
755         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
756      else      else
757         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
758         ratqs = ratqss         ratqs = ratqss
759      endif      endif
760    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
761      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
762           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, &
763           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 774  contains
774            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
775         ENDDO         ENDDO
776      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  
777    
778      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
779    
780      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
781    
782      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= - 1) THEN
783           ! seulement pour Tiedtke
784         snow_tiedtke = 0.         snow_tiedtke = 0.
785         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
786            rain_tiedtke = rain_con            rain_tiedtke = rain_con
787         else         else
788            rain_tiedtke = 0.            rain_tiedtke = 0.
789            do k = 1, llm            do k = 1, llm
790               do i = 1, klon               do i = 1, klon
791                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
792                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
793                          *zmasse(i, k)                          * zmasse(i, k)
794                  endif                  endif
795               enddo               enddo
796            enddo            enddo
797         endif         endif
798    
799         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
800         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
801              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
802         DO k = 1, llm         DO k = 1, llm
803            DO i = 1, klon            DO i = 1, klon
804               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1433  contains Line 808  contains
808            ENDDO            ENDDO
809         ENDDO         ENDDO
810      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
811         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
812         ! 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
813         ! facttemps         ! d'un facteur facttemps.
814         facteur = dtphys *facttemps         facteur = dtphys * facttemps
815         do k = 1, llm         do k = 1, llm
816            do i = 1, klon            do i = 1, klon
817               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
818               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
819                    then                    > rnebcon(i, k) * clwcon(i, k)) then
820                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
821                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
822               endif               endif
# Line 1450  contains Line 825  contains
825    
826         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
827         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
828         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
829      ENDIF      ENDIF
830    
831      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1468  contains Line 843  contains
843      ENDIF      ENDIF
844    
845      ! Precipitation totale      ! Precipitation totale
   
846      DO i = 1, klon      DO i = 1, klon
847         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
848         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
849      ENDDO      ENDDO
850    
851      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:  
852      DO k = 1, llm      DO k = 1, llm
853         DO i = 1, klon         DO i = 1, klon
854            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
855            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
856               zdelta = MAX(0., SIGN(1., rtt-zx_t))            zx_qs = MIN(0.5, zx_qs)
857               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)            zcor = 1. / (1. - retv * zx_qs)
858               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
859               zcor = 1./(1.-retv*zx_qs)            zx_rh(i, k) = q_seri(i, k) / zx_qs
              zx_qs = zx_qs*zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/play(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
860            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
861         ENDDO         ENDDO
862      ENDDO      ENDDO
863    
864      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Param\`etres optiques des nuages et quelques param\`etres pour
     ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)  
     IF (ok_ade .OR. ok_aie) THEN  
        ! Get sulfate aerosol distribution  
        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  
   
     ! Paramètres optiques des nuages et quelques paramètres pour  
865      ! diagnostics :      ! diagnostics :
866      if (ok_newmicro) then      if (ok_newmicro) then
867         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
868              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &  
             re, fl)  
869      else      else
870         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
871              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
872      endif      endif
873    
874      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
875      IF (MOD(itaprad, radpas) == 0) THEN         wo = ozonecm(REAL(julien), paprs)
876         DO i = 1, klon         albsol = sum(falbe * pctsrf, dim = 2)
877            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
878                 + falbe(i, is_lic) * pctsrf(i, is_lic) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
879                 + falbe(i, is_ter) * pctsrf(i, is_ter) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
880                 + falbe(i, is_sic) * pctsrf(i, is_sic)              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
881            albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &              swup0, swup, ok_ade, topswad, solswad)
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
        ! 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  
882      ENDIF      ENDIF
     itaprad = itaprad + 1  
883    
884      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
885      DO k = 1, llm      DO k = 1, llm
886         DO i = 1, klon         DO i = 1, klon
887            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 &
888         ENDDO                 / 86400.
     ENDDO  
   
     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  
   
     ! Calculer l'hydrologie de la surface  
     DO i = 1, klon  
        zxqsurf(i) = 0.0  
        zxsnow(i) = 0.0  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)  
889         ENDDO         ENDDO
890      ENDDO      ENDDO
891    
892      ! 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)
   
893      DO i = 1, klon      DO i = 1, klon
894         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
895      ENDDO      ENDDO
896    
897      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
898    
899      IF (ok_orodr) THEN      IF (ok_orodr) THEN
900         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
901         igwd = 0         igwd = 0
902         DO i = 1, klon         DO i = 1, klon
903            itest(i) = 0            itest(i) = 0
904            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
905               itest(i) = 1               itest(i) = 1
906               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
907            ENDIF            ENDIF
908         ENDDO         ENDDO
909    
910         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
911              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
912              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
913    
914         ! ajout des tendances         ! ajout des tendances
915         DO k = 1, llm         DO k = 1, llm
# Line 1620  contains Line 922  contains
922      ENDIF      ENDIF
923    
924      IF (ok_orolf) THEN      IF (ok_orolf) THEN
925         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
926         igwd = 0         igwd = 0
927         DO i = 1, klon         DO i = 1, klon
928            itest(i) = 0            itest(i) = 0
929            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
930               itest(i) = 1               itest(i) = 1
931               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
932            ENDIF            ENDIF
933         ENDDO         ENDDO
934    
# Line 1645  contains Line 946  contains
946         ENDDO         ENDDO
947      ENDIF      ENDIF
948    
949      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
950    
951      DO i = 1, klon      DO i = 1, klon
952         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1653  contains Line 954  contains
954      ENDDO      ENDDO
955      DO k = 1, llm      DO k = 1, llm
956         DO i = 1, klon         DO i = 1, klon
957            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 &
958            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
959              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
960                   * zmasse(i, k)
961         ENDDO         ENDDO
962      ENDDO      ENDDO
963    
964      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
965             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  
966    
967      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
968      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
969           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, &
970           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, &
971           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           zmasse, ncid_startphy)
          diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri, zmasse)  
   
     IF (offline) THEN  
        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  
972    
973      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
974      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)  
975    
976      ! diag. bilKP      ! diag. bilKP
977    
978      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, &
979           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
980    
981      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
982    
983      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
984      DO k = 1, llm      DO k = 1, llm
985         DO i = 1, klon         DO i = 1, klon
986            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
           d_t_ec(i, k) = 0.5 / ZRCPD &  
987                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
988            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
989            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
990         END DO         END DO
991      END DO      END DO
992    
     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  
   
993      ! SORTIES      ! SORTIES
994    
995      !cc prw = eau precipitable      ! prw = eau precipitable
996      DO i = 1, klon      DO i = 1, klon
997         prw(i) = 0.         prw(i) = 0.
998         DO k = 1, llm         DO k = 1, llm
999            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1000         ENDDO         ENDDO
1001      ENDDO      ENDDO
1002    
# Line 1746  contains Line 1012  contains
1012         ENDDO         ENDDO
1013      ENDDO      ENDDO
1014    
1015      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1016         DO iq = 3, nqmx         DO k = 1, llm
1017            DO k = 1, llm            DO i = 1, klon
1018               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  
1019            ENDDO            ENDDO
1020         ENDDO         ENDDO
1021      ENDIF      ENDDO
1022    
1023      ! 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:
1024      DO k = 1, llm      DO k = 1, llm
# Line 1764  contains Line 1028  contains
1028         ENDDO         ENDDO
1029      ENDDO      ENDDO
1030    
1031      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1032      call write_histhf      CALL histwrite_phy("aire", airephy)
1033      call write_histday      CALL histwrite_phy("psol", paprs(:, 1))
1034      call write_histins      CALL histwrite_phy("precip", rain_fall + snow_fall)
1035        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1036      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("pluc", rain_con + snow_con)
1037      IF (lafin) THEN      CALL histwrite_phy("tsol", tsol)
1038         itau_phy = itau_phy + itap      CALL histwrite_phy("t2m", zt2m)
1039         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("q2m", zq2m)
1040              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("u10m", u10m)
1041              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &      CALL histwrite_phy("v10m", v10m)
1042              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("snow", snow_fall)
1043              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)      CALL histwrite_phy("cdrm", cdragm)
1044      ENDIF      CALL histwrite_phy("cdrh", cdragh)
1045        CALL histwrite_phy("topl", toplw)
1046      firstcal = .FALSE.      CALL histwrite_phy("evap", evap)
1047        CALL histwrite_phy("sols", solsw)
1048    contains      CALL histwrite_phy("soll", sollw)
1049        CALL histwrite_phy("solldown", sollwdown)
1050      subroutine write_histday      CALL histwrite_phy("bils", bils)
1051        CALL histwrite_phy("sens", - sens)
1052        use gr_phy_write_3d_m, only: gr_phy_write_3d      CALL histwrite_phy("fder", fder)
1053        integer itau_w ! pas de temps ecriture      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1054        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1055        !------------------------------------------------      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1056        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  
   
       !------------------------------------------------  
1057    
1058        call write_histhf3d      DO nsrf = 1, nbsrf
1059           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1060        IF (ok_sync) THEN         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1061           call histsync(nid_hf)         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1062        ENDIF         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1063           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1064      end subroutine write_histhf         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1065           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1066      !***************************************************************         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1067           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1068      subroutine write_histins         CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1069           CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1070        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09      END DO
   
       real zout  
       integer itau_w ! pas de temps ecriture  
   
       !--------------------------------------------------  
   
       IF (ok_instan) THEN  
          ! Champs 2D:  
   
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
          itau_w = itau_phy + itap  
   
          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  
1071    
1072        if (ok_sync) then      CALL histwrite_phy("albs", albsol)
1073           call histsync(nid_hf3d)      CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1074        endif      CALL histwrite_phy("rugs", zxrugs)
1075        CALL histwrite_phy("s_pblh", s_pblh)
1076        CALL histwrite_phy("s_pblt", s_pblt)
1077        CALL histwrite_phy("s_lcl", s_lcl)
1078        CALL histwrite_phy("s_capCL", s_capCL)
1079        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1080        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1081        CALL histwrite_phy("s_therm", s_therm)
1082        CALL histwrite_phy("s_trmb1", s_trmb1)
1083        CALL histwrite_phy("s_trmb2", s_trmb2)
1084        CALL histwrite_phy("s_trmb3", s_trmb3)
1085    
1086        if (conv_emanuel) then
1087           CALL histwrite_phy("ptop", ema_pct)
1088           CALL histwrite_phy("dnwd0", - mp)
1089        end if
1090    
1091        CALL histwrite_phy("temp", t_seri)
1092        CALL histwrite_phy("vitu", u_seri)
1093        CALL histwrite_phy("vitv", v_seri)
1094        CALL histwrite_phy("geop", zphi)
1095        CALL histwrite_phy("pres", play)
1096        CALL histwrite_phy("dtvdf", d_t_vdf)
1097        CALL histwrite_phy("dqvdf", d_q_vdf)
1098        CALL histwrite_phy("rhum", zx_rh)
1099        CALL histwrite_phy("d_t_ec", d_t_ec)
1100        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1101        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1102        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1103        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1104    
1105        if (ok_instan) call histsync(nid_ins)
1106    
1107        IF (lafin) then
1108           call NF95_CLOSE(ncid_startphy)
1109           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1110                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1111                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1112                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1113                w01)
1114        end IF
1115    
1116      end subroutine write_histhf3d      firstcal = .FALSE.
1117    
1118    END SUBROUTINE physiq    END SUBROUTINE physiq
1119    

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

  ViewVC Help
Powered by ViewVC 1.1.21