/[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/phylmd/physiq.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/Sources/phylmd/physiq.f revision 226 by guez, Mon Oct 16 13:04:05 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      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
12    
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z. X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
17      use aaam_bud_m, only: aaam_bud      use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
     use aeropt_m, only: aeropt  
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 clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      USE comgeomphy, ONLY: airephy, cuphy, cvphy      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      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 diagphy_m, only: diagphy      USE dimphy, ONLY: klon
     USE dimens_m, ONLY: iim, jjm, llm, nqmx  
     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      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, 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
     USE ini_histins_m, ONLY: ini_histins  
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49      USE oasis_m, ONLY: ok_oasis      use 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 readsulfate_m, only: readsulfate      use yoegwd, only: sugwd
59      use sugwd_m, only: sugwd      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
60      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use time_phylmdz, only: itap, increment_itap
61      USE temps, ONLY: annee_ref, day_ref, itau_phy      use transp_m, only: transp
62        use transp_lay_m, only: transp_lay
63      use unit_nml_m, only: unit_nml      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_gust ! pour activer l'effet des gust sur flux surface      ! Local:
     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):: ocean = 'force '  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
   
     ! "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:: ok_veget = .false. ! type de modele de vegetation utilise  
   
     logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.  
     ! sorties journalieres, mensuelles et instantanees dans les  
     ! fichiers histday, histmth et histins  
   
     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  
   
     REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)  
     REAL swup0(klon, llm + 1), swup(klon, llm + 1)  
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)  
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     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.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)
# Line 270  contains Line 151  contains
151    
152      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! 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  
   
     REAL, save:: qsol(klon) ! hauteur d'eau dans le sol  
154    
155      REAL fsnow(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
156      SAVE fsnow ! epaisseur neigeuse      ! humidite de l'air au contact de la surface
157    
158      REAL falbe(klon, nbsrf)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
159      SAVE falbe ! albedo par type de surface      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
160      REAL falblw(klon, nbsrf)      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     SAVE falblw ! albedo par type de surface  
161    
162      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle 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)
     REAL agesno(klon, nbsrf)  
     SAVE agesno ! age de la neige  
176    
177      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
178      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
179      !KE43      REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
     REAL Ma(klon, llm) ! undilute upward mass flux  
     SAVE Ma  
     REAL qcondc(klon, llm) ! in-cld water content from convect  
     SAVE qcondc  
180      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables locales pour la couche limite (al1):  
   
     ! Variables locales:  
181    
182        ! Variables pour la couche limite (Alain Lahellec) :
183      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
184      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
185    
186      ! Pour phytrac :      ! Pour phytrac :
187      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
188      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon), yv1(klon) ! vent dans la premi\`ere couche
189      REAL yv1(klon) ! vents dans la premiere couche V  
190      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige      REAL, save:: ffonte(klon, nbsrf)
191      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      ! flux thermique utilise pour fondre la neige
192      ! !et necessaire pour limiter la  
193      ! !hauteur de neige, en kg/m2/s      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      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
198    
199      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
200      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
201      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
202      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
203      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
204      save pfrac_1nucl  
205      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
206      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
207    
208      REAL, save:: rain_fall(klon) ! pluie      REAL, save:: rain_fall(klon)
209      REAL, save:: snow_fall(klon) ! neige      ! liquid water mass flux (kg / m2 / s), positive down
210    
211        REAL, save:: snow_fall(klon)
212        ! 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 and its derivative      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
   
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
234      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
235      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
   
     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
     ! Declaration des procedures appelees  
   
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
238    
239      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
240      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 401  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 calculé tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
256      ! 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, save:: 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, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
262      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
263      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
264      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
265      REAL albpla(klon)      REAL, save:: albpla(klon)
266      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
267      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
268      SAVE albpla  
269      SAVE heat0, cool0      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
270        REAL conv_t(klon, llm) ! convergence of temperature (K / s)
271      INTEGER itaprad  
272      SAVE itaprad      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
273        REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
274      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)  
275      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL zxfluxlat(klon)
276        REAL dist, mu0(klon), fract(klon)
277      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      real longi
     REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree  
   
     REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)  
   
     REAL dist, rmu0(klon), fract(klon)  
     REAL zdtime ! pas de temps du rayonnement (s)  
     real zlongi  
278      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
279      REAL za, zb      REAL zb
280      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
281      real zqsat(klon, llm)      real zqsat(klon, llm)
282      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
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 :      ! 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:  
     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)
# Line 508  contains Line 330  contains
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 534  contains Line 359  contains
359      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
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 550  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  
   
     logical ok_sync  
381      real date0      real date0
382        REAL tsol(klon)
383    
384      ! Variables liées au bilan d'énergie et d'enthalpie :      REAL d_t_ec(klon, llm)
385      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
386      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      ! énergie thermique
387      REAL, SAVE:: d_h_vcol_phy  
388      REAL fs_bound, fq_bound      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
389      REAL zero_v(klon)      ! temperature and humidity at 2 m
390      CHARACTER(LEN = 15) tit  
391      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
392      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      ! composantes du vent \`a 10 m
393        
394      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
395      REAL ZRCPD      REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
   
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m  
     REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille  
396    
397      ! Aerosol effects:      ! Aerosol effects:
398    
399      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
   
     REAL, save:: sulfate_pi(klon, llm)  
     ! SO4 aerosol concentration, in micro g/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, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL, save:: cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! aerosol direct effect  
     REAL topswai(klon), solswai(klon) ! aerosol indirect effect  
   
     REAL aerindex(klon) ! POLDER aerosol index  
   
400      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
401    
402      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
403      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
404      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
405      ! concentration.      ! concentration.
406    
407      SAVE u10m      real zmasse(klon, llm)
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
     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/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
413           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
          ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &  
414           nsplit_thermals           nsplit_thermals
415    
416      !----------------------------------------------------------------      !----------------------------------------------------------------
417    
     IF (if_ebil >= 1) zero_v = 0.  
     ok_sync = .TRUE.  
418      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
419           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
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.
        cg_ae = 0.  
        rain_con(:) = 0.  
        snow_con(:) = 0.  
        topswai(:) = 0.  
        topswad(:) = 0.  
        solswai(:) = 0.  
        solswad(:) = 0.  
   
431         d_u_con = 0.         d_u_con = 0.
432         d_v_con = 0.         d_v_con = 0.
433         rnebcon0 = 0.         rnebcon0 = 0.
434         clwcon0 = 0.         clwcon0 = 0.
435         rnebcon = 0.         rnebcon = 0.
436         clwcon = 0.         clwcon = 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    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
448         iflag_thermals = 0         iflag_thermals = 0
449         nsplit_thermals = 1         nsplit_thermals = 1
450         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 696  contains Line 456  contains
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, sollw, 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, sig1, w01)  
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 = 1e-8         q2 = 1e-8
467    
468         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = lmt_pas / nbapp_rad
469           print *, "radpas = ", radpas
470    
471         ! on remet le calendrier a zero         ! Initialisation pour le sch\'ema de convection d'Emanuel :
472         IF (raz_date) itau_phy = 0         IF (conv_emanuel) THEN
   
        PRINT *, 'cycle_diurne = ', cycle_diurne  
        CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &  
             ok_instan, ok_region)  
   
        IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
        ! Initialisation pour le schéma de convection d'Emanuel :  
        IF (iflag_con >= 3) THEN  
473            ibas_con = 1            ibas_con = 1
474            itop_con = 1            itop_con = 1
475         ENDIF         ENDIF
# Line 735  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  
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)
        call ini_histins(dtphys, ok_instan, nid_ins)  
        CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)  
490         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
491         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
492           CALL phyredem0
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      DO i = 1, klon      t_seri = t
498         d_ps(i) = 0.      u_seri = u
499      ENDDO      v_seri = v
500      DO iq = 1, nqmx      q_seri = qx(:, :, ivap)
501         DO k = 1, llm      ql_seri = qx(:, :, iliq)
502            DO i = 1, klon      tr_seri = qx(:, :, 3:nqmx)
              d_qx(i, k, iq) = 0.  
           ENDDO  
        ENDDO  
     ENDDO  
     da = 0.  
     mp = 0.  
     phi = 0.  
   
     ! Ne pas affecter les valeurs entrées de u, v, h, et q :  
   
     DO k = 1, llm  
        DO i = 1, klon  
           t_seri(i, k) = t(i, k)  
           u_seri(i, k) = u(i, k)  
           v_seri(i, k) = v(i, k)  
           q_seri(i, k) = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
   
     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  
503    
504      IF (if_ebil >= 1) THEN      tsol = sum(ftsol * pctsrf, dim = 2)
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, 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, tit, 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 845  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.  
     wo = ozonecm(REAL(julien), paprs)  
   
     ! É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 868  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         tit = 'after reevap'      zxrugs = sum(frugs * pctsrf, dim = 2)
        CALL diagetpq(airephy, tit, 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, tit, 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  
553    
554      ! Appeler la diffusion verticale (programme de couche limite)      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
555        ! la surface.
     DO i = 1, klon  
        zxrugs(i) = 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  
556    
557      ! calculs necessaires au calcul de l'albedo dans l'interface      CALL orbite(REAL(julien), longi, dist)
558        CALL zenang(longi, time, dtphys * radpas, mu0, fract)
559      CALL orbite(REAL(julien), zlongi, dist)      albsol = sum(falbe * pctsrf, dim = 2)
560      IF (cycle_diurne) THEN  
561         zdtime = dtphys * REAL(radpas)      ! R\'epartition sous maille des flux longwave et shortwave
562         CALL zenang(zlongi, time, zdtime, rmu0, fract)      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
563      ELSE  
564         rmu0 = -999.999      forall (nsrf = 1: nbsrf)
565      ENDIF         fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
566                * (tsol - ftsol(:, nsrf))
567      ! Calcul de l'abedo moyen par maille         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
568      albsol(:) = 0.      END forall
569      albsollw(:) = 0.  
570      DO nsrf = 1, nbsrf      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
571         DO i = 1, klon           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
572            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
573            albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)           snow_fall, fsolsw, fsollw, frugs, agesno, rugoro, d_t_vdf, d_q_vdf, &
574         ENDDO           d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, &
575      ENDDO           cdragm, q2, dsens, devap, ycoefh, t2m, q2m, u10m_srf, v10m_srf, &
   
     ! Répartition sous maille des flux longwave et shortwave  
     ! Répartition du longwave par sous-surface linéarisée  
   
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           fsollw(i, nsrf) = sollw(i) &  
                + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))  
           fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))  
        ENDDO  
     ENDDO  
   
     fder = dlw  
   
     ! Couche limite:  
   
     CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &  
          u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &  
          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, fder, rlon, rlat, &  
          frugs, firstcal, 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, &  
576           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
577           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0)
578    
579      ! Incrémentation des flux      ! Incr\'ementation des flux
580    
581      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
582      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
583      zxfluxu = 0.      fder = dlw + dsens + devap
584      zxfluxv = 0.  
585      DO nsrf = 1, nbsrf      yu1 = u_seri(:, 1)
586         DO k = 1, llm      yv1 = v_seri(:, 1)
           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'évaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
587    
588      DO k = 1, llm      DO k = 1, llm
589         DO i = 1, klon         DO i = 1, klon
# Line 972  contains Line 594  contains
594         ENDDO         ENDDO
595      ENDDO      ENDDO
596    
     IF (if_ebil >= 2) THEN  
        tit = 'after clmain'  
        CALL diagetpq(airephy, tit, 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, tit, 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  
   
597      ! Update surface temperature:      ! Update surface temperature:
598    
599      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
600         zxtsol(i) = 0.      ftsol = ftsol + d_ts
601         zxfluxlat(i) = 0.      tsol = sum(ftsol * pctsrf, dim = 2)
602        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
603         zt2m(i) = 0.      zt2m = sum(t2m * pctsrf, dim = 2)
604         zq2m(i) = 0.      zq2m = sum(q2m * pctsrf, dim = 2)
605         zu10m(i) = 0.      u10m = sum(u10m_srf * pctsrf, dim = 2)
606         zv10m(i) = 0.      v10m = sum(v10m_srf * pctsrf, dim = 2)
607         zxffonte(i) = 0.      zxffonte = sum(ffonte * pctsrf, dim = 2)
608         zxfqcalving(i) = 0.      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
609        s_pblh = sum(pblh * pctsrf, dim = 2)
610         s_pblh(i) = 0.      s_lcl = sum(plcl * pctsrf, dim = 2)
611         s_lcl(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
612         s_capCL(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
613         s_oliqCL(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
614         s_cteiCL(i) = 0.      s_pblT = sum(pblT * pctsrf, dim = 2)
615         s_pblT(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
616         s_therm(i) = 0.      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
617         s_trmb1(i) = 0.      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
618         s_trmb2(i) = 0.      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
        s_trmb3(i) = 0.  
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &  
             + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &  
             'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)  
     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  
619    
620        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
621      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
622         DO i = 1, klon         DO i = 1, klon
623            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
624                 ftsol(i, nsrf) = tsol(i)
625            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
626            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
627            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
628            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
629            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
630            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
631                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
632            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
633            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
634            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
635            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
636            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
637            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
638            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
639            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
640            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
641            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
        ENDDO  
     ENDDO  
   
     ! Calculer la derive du flux infrarouge  
   
     DO i = 1, klon  
        dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
     ENDDO  
   
     ! Appeler la convection (au choix)  
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys  
           conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys  
642         ENDDO         ENDDO
643      ENDDO      ENDDO
644    
645      IF (check) THEN      dlw = - 4. * RSIGMA * tsol**3
646         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
647         print *, "avantcon = ", za      ! Appeler la convection
648      ENDIF  
649        if (conv_emanuel) then
650      if (iflag_con == 2) then         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
651         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
652         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
653              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &         snow_con = 0.
             d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &  
             mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &  
             kdtop, pmflxr, pmflxs)  
        WHERE (rain_con < 0.) rain_con = 0.  
        WHERE (snow_con < 0.) snow_con = 0.  
        ibas_con = llm + 1 - kcbot  
        itop_con = llm + 1 - kctop  
     else  
        ! iflag_con >= 3  
   
        CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &  
             v_seri, tr_seri, sig1, w01, 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, ntra=1)  
        ! (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.)  
   
654         clwcon0 = qcondc         clwcon0 = qcondc
655         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
   
        ! Calcul des propriétés des nuages convectifs  
656    
657         DO k = 1, llm         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
658            DO i = 1, klon         zqsat = zqsat / (1. - retv * zqsat)
              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  
659    
660         ! calcul des proprietes des nuages convectifs         ! Properties of convective clouds
661         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
662         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
663              rnebcon0)              rnebcon0)
664    
665           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
666         mfd = 0.         mfd = 0.
667         pen_u = 0.         pen_u = 0.
668         pen_d = 0.         pen_d = 0.
669         pde_d = 0.         pde_d = 0.
670         pde_u = 0.         pde_u = 0.
671        else
672           conv_q = d_q_dyn + d_q_vdf / dtphys
673           conv_t = d_t_dyn + d_t_vdf / dtphys
674           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
675           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
676                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
677                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
678                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
679                kdtop, pmflxr, pmflxs)
680           WHERE (rain_con < 0.) rain_con = 0.
681           WHERE (snow_con < 0.) snow_con = 0.
682           ibas_con = llm + 1 - kcbot
683           itop_con = llm + 1 - kctop
684      END if      END if
685    
686      DO k = 1, llm      DO k = 1, llm
# Line 1154  contains Line 692  contains
692         ENDDO         ENDDO
693      ENDDO      ENDDO
694    
695      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, 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, tit, 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.  
        za = 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 (iflag_con == 2) THEN  
696         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
697         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
698         DO k = 1, llm         DO k = 1, llm
# Line 1190  contains Line 704  contains
704         ENDDO         ENDDO
705      ENDIF      ENDIF
706    
707      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
708    
709      d_t_ajs = 0.      d_t_ajs = 0.
710      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1205  contains Line 719  contains
719         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
720         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
721      else      else
        ! Thermiques  
722         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
723              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)
724      endif      endif
725    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, 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  
   
726      ! Caclul des ratqs      ! Caclul des ratqs
727    
728      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
729      ! on écrase le tableau ratqsc calculé par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
730      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
731         do k = 1, llm         do k = 1, llm
732            do i = 1, klon            do i = 1, klon
# Line 1238  contains Line 744  contains
744      do k = 1, llm      do k = 1, llm
745         do i = 1, klon         do i = 1, klon
746            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
747                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
748         enddo         enddo
749      enddo      enddo
750    
# Line 1271  contains Line 777  contains
777            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
778         ENDDO         ENDDO
779      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 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  
        tit = 'after fisrt'  
        CALL diagetpq(airephy, tit, 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, tit, 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  
780    
781      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
782    
783      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
784    
785      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
786         ! seulement pour Tiedtke         ! seulement pour Tiedtke
787         snow_tiedtke = 0.         snow_tiedtke = 0.
788         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
789            rain_tiedtke = rain_con            rain_tiedtke = rain_con
790         else         else
791            rain_tiedtke = 0.            rain_tiedtke = 0.
792            do k = 1, llm            do k = 1, llm
793               do i = 1, klon               do i = 1, klon
794                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
795                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
796                          *zmasse(i, k)                          * zmasse(i, k)
797                  endif                  endif
798               enddo               enddo
799            enddo            enddo
# Line 1329  contains Line 812  contains
812         ENDDO         ENDDO
813      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
814         ! On prend pour les nuages convectifs le maximum du calcul de         ! On prend pour les nuages convectifs le maximum du calcul de
815         ! la convection et du calcul du pas de temps précédent diminué         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
816         ! d'un facteur facttemps.         ! d'un facteur facttemps.
817         facteur = dtphys * facttemps         facteur = dtphys * facttemps
818         do k = 1, llm         do k = 1, llm
# Line 1345  contains Line 828  contains
828    
829         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
830         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
831         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
832      ENDIF      ENDIF
833    
834      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1368  contains Line 851  contains
851         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
852      ENDDO      ENDDO
853    
854      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &      ! Humidit\'e relative pour diagnostic :
          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)  
   
     ! Humidité relative pour diagnostic :  
855      DO k = 1, llm      DO k = 1, llm
856         DO i = 1, klon         DO i = 1, klon
857            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
858            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
859               zdelta = MAX(0., SIGN(1., rtt-zx_t))            zx_qs = MIN(0.5, zx_qs)
860               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)            zcor = 1. / (1. - retv * zx_qs)
861               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
862               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  
863            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
864         ENDDO         ENDDO
865      ENDDO      ENDDO
866    
867      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Param\`etres optiques des nuages et quelques param\`etres pour
868      IF (ok_ade .OR. ok_aie) THEN      ! diagnostics :
        ! Get sulfate aerosol distribution :  
        CALL readsulfate(rdayvrai, firstcal, sulfate)  
        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)  
   
        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 diagnostics :  
869      if (ok_newmicro) then      if (ok_newmicro) then
870         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
871              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)  
872      else      else
873         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
874              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
875      endif      endif
876    
877      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
878      IF (MOD(itaprad, radpas) == 0) THEN         wo = ozonecm(REAL(julien), paprs)
879         DO i = 1, klon         albsol = sum(falbe * pctsrf, dim = 2)
880            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
881                 + falbe(i, is_lic) * pctsrf(i, is_lic) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
882                 + falbe(i, is_ter) * pctsrf(i, is_ter) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
883                 + falbe(i, is_sic) * pctsrf(i, is_sic)              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
884            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  
        ! 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  
885      ENDIF      ENDIF
     itaprad = itaprad + 1  
886    
887      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
888      DO k = 1, llm      DO k = 1, llm
889         DO i = 1, klon         DO i = 1, klon
890            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 &
891                   / 86400.
892         ENDDO         ENDDO
893      ENDDO      ENDDO
894    
895      IF (if_ebil >= 2) THEN      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, 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, tit, 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.  
        zxsnow(i) = 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)  
        ENDDO  
     ENDDO  
   
     ! Calculer le bilan du sol et la dérive de température (couplage)  
   
896      DO i = 1, klon      DO i = 1, klon
897         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
898      ENDDO      ENDDO
899    
900      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
901    
902      IF (ok_orodr) THEN      IF (ok_orodr) THEN
903         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
904         igwd = 0         igwd = 0
905         DO i = 1, klon         DO i = 1, klon
906            itest(i) = 0            itest(i) = 0
907            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
908               itest(i) = 1               itest(i) = 1
909               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
910            ENDIF            ENDIF
911         ENDDO         ENDDO
912    
913         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
914              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
915              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
916    
917         ! ajout des tendances         ! ajout des tendances
918         DO k = 1, llm         DO k = 1, llm
# Line 1507  contains Line 925  contains
925      ENDIF      ENDIF
926    
927      IF (ok_orolf) THEN      IF (ok_orolf) THEN
928         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
929         igwd = 0         igwd = 0
930         DO i = 1, klon         DO i = 1, klon
931            itest(i) = 0            itest(i) = 0
932            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
933               itest(i) = 1               itest(i) = 1
934               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
935            ENDIF            ENDIF
936         ENDDO         ENDDO
937    
# Line 1532  contains Line 949  contains
949         ENDDO         ENDDO
950      ENDIF      ENDIF
951    
952      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
953    
954      DO i = 1, klon      DO i = 1, klon
955         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1547  contains Line 964  contains
964         ENDDO         ENDDO
965      ENDDO      ENDDO
966    
967      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
968           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
   
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', 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)  
969    
970      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
971      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
972           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
973           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
974           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           zmasse, ncid_startphy)
          pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
   
     IF (offline) THEN  
        call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, 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  
975    
976      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
977      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)  
978    
979      ! diag. bilKP      ! diag. bilKP
980    
981      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, &
982           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
983    
984      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
985    
986      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
987      DO k = 1, llm      DO k = 1, llm
988         DO i = 1, klon         DO i = 1, klon
989            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 &  
990                 * (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)
991            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)
992            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
993         END DO         END DO
994      END DO      END DO
995    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, 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, tit, 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  
   
996      ! SORTIES      ! SORTIES
997    
998      ! prw = eau precipitable      ! prw = eau precipitable
999      DO i = 1, klon      DO i = 1, klon
1000         prw(i) = 0.         prw(i) = 0.
1001         DO k = 1, llm         DO k = 1, llm
1002            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1003         ENDDO         ENDDO
1004      ENDDO      ENDDO
1005    
# Line 1628  contains Line 1015  contains
1015         ENDDO         ENDDO
1016      ENDDO      ENDDO
1017    
1018      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1019         DO iq = 3, nqmx         DO k = 1, llm
1020            DO k = 1, llm            DO i = 1, klon
1021               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  
1022            ENDDO            ENDDO
1023         ENDDO         ENDDO
1024      ENDIF      ENDDO
1025    
1026      ! 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:
1027      DO k = 1, llm      DO k = 1, llm
# Line 1646  contains Line 1031  contains
1031         ENDDO         ENDDO
1032      ENDDO      ENDDO
1033    
1034      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1035      call write_histhf      CALL histwrite_phy("aire", airephy)
1036      call write_histday      CALL histwrite_phy("psol", paprs(:, 1))
1037      call write_histins      CALL histwrite_phy("precip", rain_fall + snow_fall)
1038        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1039      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("pluc", rain_con + snow_con)
1040      IF (lafin) THEN      CALL histwrite_phy("tsol", tsol)
1041         itau_phy = itau_phy + itap      CALL histwrite_phy("t2m", zt2m)
1042         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("q2m", zq2m)
1043              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("u10m", u10m)
1044              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &      CALL histwrite_phy("v10m", v10m)
1045              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("snow", snow_fall)
1046              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      CALL histwrite_phy("cdrm", cdragm)
1047      ENDIF      CALL histwrite_phy("cdrh", cdragh)
1048        CALL histwrite_phy("topl", toplw)
1049      firstcal = .FALSE.      CALL histwrite_phy("evap", evap)
1050        CALL histwrite_phy("sols", solsw)
1051    contains      CALL histwrite_phy("soll", sollw)
1052        CALL histwrite_phy("solldown", sollwdown)
1053      subroutine write_histday      CALL histwrite_phy("bils", bils)
1054        CALL histwrite_phy("sens", - sens)
1055        use gr_phy_write_3d_m, only: gr_phy_write_3d      CALL histwrite_phy("fder", fder)
1056        integer itau_w ! pas de temps ecriture      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1057        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1058        !------------------------------------------------      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1059        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
   
     subroutine write_histins  
   
       ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09  
   
       real zout  
       integer itau_w ! pas de temps ecriture  
   
       !--------------------------------------------------  
1060    
1061        IF (ok_instan) THEN      DO nsrf = 1, nbsrf
1062           ! Champs 2D:         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1063           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1064           zsto = dtphys * ecrit_ins         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1065           zout = dtphys * ecrit_ins         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1066           itau_w = itau_phy + itap         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1067           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1068           i = NINT(zout/zsto)         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1069           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1070           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1071           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1072           i = NINT(zout/zsto)         CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1073           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)      END DO
          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  
1074    
1075        if (ok_sync) then      CALL histwrite_phy("albs", albsol)
1076           call histsync(nid_hf3d)      CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1077        endif      CALL histwrite_phy("rugs", zxrugs)
1078        CALL histwrite_phy("s_pblh", s_pblh)
1079        CALL histwrite_phy("s_pblt", s_pblt)
1080        CALL histwrite_phy("s_lcl", s_lcl)
1081        CALL histwrite_phy("s_capCL", s_capCL)
1082        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1083        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1084        CALL histwrite_phy("s_therm", s_therm)
1085        CALL histwrite_phy("s_trmb1", s_trmb1)
1086        CALL histwrite_phy("s_trmb2", s_trmb2)
1087        CALL histwrite_phy("s_trmb3", s_trmb3)
1088    
1089        if (conv_emanuel) then
1090           CALL histwrite_phy("ptop", ema_pct)
1091           CALL histwrite_phy("dnwd0", - mp)
1092        end if
1093    
1094        CALL histwrite_phy("temp", t_seri)
1095        CALL histwrite_phy("vitu", u_seri)
1096        CALL histwrite_phy("vitv", v_seri)
1097        CALL histwrite_phy("geop", zphi)
1098        CALL histwrite_phy("pres", play)
1099        CALL histwrite_phy("dtvdf", d_t_vdf)
1100        CALL histwrite_phy("dqvdf", d_q_vdf)
1101        CALL histwrite_phy("rhum", zx_rh)
1102        CALL histwrite_phy("d_t_ec", d_t_ec)
1103        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1104        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1105        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1106        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1107    
1108        if (ok_instan) call histsync(nid_ins)
1109    
1110        IF (lafin) then
1111           call NF95_CLOSE(ncid_startphy)
1112           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1113                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1114                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1115                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1116                w01)
1117        end IF
1118    
1119      end subroutine write_histhf3d      firstcal = .FALSE.
1120    
1121    END SUBROUTINE physiq    END SUBROUTINE physiq
1122    

Legend:
Removed from v.76  
changed lines
  Added in v.226

  ViewVC Help
Powered by ViewVC 1.1.21