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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 34 by guez, Wed Jun 2 11:01:12 2010 UTC trunk/Sources/phylmd/physiq.f revision 151 by guez, Tue Jun 23 15:14:20 2015 UTC
# Line 1  Line 1 
1  module physiq_m  module physiq_m
2    
   ! This module is clean: no C preprocessor directive, no include line.  
   
3    IMPLICIT none    IMPLICIT none
4    
   private  
   public physiq  
   
5  contains  contains
6    
7    SUBROUTINE physiq(firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, dayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)
9         d_t, d_qx, d_ps, dudyn, PVteta)  
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! (subversion revision 678)
12    
13      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      ! Objet: Moniteur general de la physique du modele      ! This is the main procedure for the "physics" part of the program.
16      !AA      Modifications quant aux traceurs :  
17      !AA                  -  uniformisation des parametrisations ds phytrac      use aaam_bud_m, only: aaam_bud
18      !AA                  -  stockage des moyennes des champs necessaires      USE abort_gcm_m, ONLY: abort_gcm
19      !AA                     en mode traceur off-line      use aeropt_m, only: aeropt
20        use ajsec_m, only: ajsec
21      use abort_gcm_m, only: abort_gcm      use calltherm_m, only: calltherm
22      USE calendar, only: ymds2ju      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
23      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24           cdmmax, cdhmax, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
25           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &           ok_orodr, ok_orolf
26           ok_kzmin      USE clmain_m, ONLY: clmain
27      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use clouds_gno_m, only: clouds_gno
28           cycle_diurne, new_oliq, soil_model      USE comgeomphy, ONLY: airephy
29      use comgeomphy      USE concvl_m, ONLY: concvl
30      use conf_gcm_m, only: raz_date, offline      USE conf_gcm_m, ONLY: offline, raz_date
31      use conf_phys_m, only: conf_phys      USE conf_phys_m, ONLY: conf_phys
32      use ctherm      use conflx_m, only: conflx
33      use dimens_m, only: jjm, iim, llm, nqmx      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use dimphy, only: klon, nbtr      use diagcld2_m, only: diagcld2
35      use dimsoil, only: nsoilmx      use diagetpq_m, only: diagetpq
36      use hgardfou_m, only: hgardfou      use diagphy_m, only: diagphy
37      USE histcom, only: histsync      USE dimens_m, ONLY: llm, nqmx
38      USE histwrite_m, only: histwrite      USE dimphy, ONLY: klon
39      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      USE dimsoil, ONLY: nsoilmx
40           clnsurf, epsfra      use drag_noro_m, only: drag_noro
41      use ini_histhf_m, only: ini_histhf      use dynetat0_m, only: day_ref, annee_ref
42      use ini_histday_m, only: ini_histday      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43      use ini_histins_m, only: ini_histins      use fisrtilp_m, only: fisrtilp
44      use iniprint, only: prt_level      USE hgardfou_m, ONLY: hgardfou
45      use oasis_m      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
46      use orbite_m, only: orbite, zenang           nbsrf
47      use ozonecm_m, only: ozonecm      USE ini_histins_m, ONLY: ini_histins
48      use phyetat0_m, only: phyetat0, rlat, rlon      use newmicro_m, only: newmicro
49      use phyredem_m, only: phyredem      USE orbite_m, ONLY: orbite
50      use phystokenc_m, only: phystokenc      USE ozonecm_m, ONLY: ozonecm
51      use phytrac_m, only: phytrac      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
52      use qcheck_m, only: qcheck      USE phyredem_m, ONLY: phyredem
53      use radepsi      USE phystokenc_m, ONLY: phystokenc
54      use radopt      USE phytrac_m, ONLY: phytrac
55      use temps, only: itau_phy, day_ref, annee_ref      USE qcheck_m, ONLY: qcheck
56      use yoethf      use radlwsw_m, only: radlwsw
57      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use readsulfate_m, only: readsulfate
58        use readsulfate_preind_m, only: readsulfate_preind
59      ! Declaration des constantes et des fonctions thermodynamiques :      use sugwd_m, only: sugwd
60      use fcttre, only: thermcep, foeew, qsats, qsatl      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61        USE temps, ONLY: itau_phy
62      ! Variables argument:      use unit_nml_m, only: unit_nml
63        USE ymds2ju_m, ONLY: ymds2ju
64      REAL, intent(in):: rdayvrai      USE yoethf_m, ONLY: r2es, rvtmp2
65      ! (elapsed time since January 1st 0h of the starting year, in days)      use zenang_m, only: zenang
66    
     REAL, intent(in):: gmtime ! heure de la journée en fraction de jour  
     REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)  
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
67      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
68    
69      REAL, intent(in):: paprs(klon, llm+1)      integer, intent(in):: dayvrai
70      ! (pression pour chaque inter-couche, en Pa)      ! current day number, based at value 1 on January 1st of annee_ref
71    
72        REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
73        REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
74    
75      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! (input pression pour le mileu de chaque couche (en Pa))      ! pression pour chaque inter-couche, en Pa
77    
78      REAL pphi(klon, llm)        REAL, intent(in):: play(:, :) ! (klon, llm)
79      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! pression pour le mileu de chaque couche (en Pa)
80    
81      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82        ! géopotentiel de chaque couche (référence sol)
83    
84      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
     REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s  
     REAL 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 d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
     REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
     REAL d_t(klon, llm)  ! output 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      INTEGER nbteta      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93      PARAMETER(nbteta=3)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      REAL PVteta(klon, nbteta)      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s
96      ! (output vorticite potentielle a des thetas constantes)      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, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101        ! tendance physique de "qx" (s-1)
102    
103        ! Local:
104    
105        LOGICAL:: firstcal = .true.
106    
     LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
107      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
108      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
109    
110      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL, PARAMETER:: check = .FALSE.
111      PARAMETER (check=.FALSE.)      ! Verifier la conservation du modele en eau
     LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
     PARAMETER (ok_stratus=.FALSE.)  
   
     ! Parametres lies au coupleur OASIS:  
     INTEGER, SAVE :: npas, nexca  
     logical rnpb  
     parameter(rnpb=.true.)  
   
     character(len=6), save:: ocean  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
   
     logical ok_ocean  
     SAVE ok_ocean  
   
     !IM "slab" ocean  
     REAL tslab(klon)    !Temperature du slab-ocean  
     SAVE tslab  
     REAL seaice(klon)   !glace de mer (kg/m2)  
     SAVE seaice  
     REAL fluxo(klon)    !flux turbulents ocean-glace de mer  
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
   
     ! Modele thermique du sol, a activer pour le cycle diurne:  
     logical, save:: ok_veget  
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
112    
113      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
114        ! Ajouter artificiellement les stratus
115    
116      LOGICAL ok_instan ! sortir le fichier instantane      ! "slab" ocean
117      save ok_instan      REAL, save:: tslab(klon) ! temperature of ocean slab
118        REAL, save:: seaice(klon) ! glace de mer (kg/m2)
119        REAL fluxo(klon) ! flux turbulents ocean-glace de mer
120        REAL fluxg(klon) ! flux turbulents ocean-atmosphere
121    
122        logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
123        ! sorties journalieres, mensuelles et instantanees dans les
124        ! fichiers histday, histmth et histins
125    
126      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
127      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
128    
129      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
130      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
131      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
132      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
133      save q2  
134        INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
135        INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
136    
137      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
138      PARAMETER (ivap=1)      LOGICAL, save:: ancien_ok
     INTEGER iliq          ! indice de traceurs pour eau liquide  
     PARAMETER (iliq=2)  
   
     REAL t_ancien(klon, llm), q_ancien(klon, llm)  
     SAVE t_ancien, q_ancien  
     LOGICAL ancien_ok  
     SAVE ancien_ok  
139    
140      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
141      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)
142    
143      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
144    
145      !IM Amip2 PV a theta constante      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
146        REAL swup0(klon, llm + 1), swup(klon, llm + 1)
     CHARACTER(LEN=3) ctetaSTD(nbteta)  
     DATA ctetaSTD/'350', '380', '405'/  
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
     INTEGER klevp1  
     PARAMETER(klevp1=llm+1)  
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
147      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
148    
149      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
150      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
151      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
152    
153      !IM Amip2      ! Amip2
154      ! variables a une pression donnee      ! variables a une pression donnee
155    
156      integer nlevSTD      integer nlevSTD
157      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
158      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
159      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
160           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
161           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
162      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
163      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
164           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
165           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
166    
167      ! prw: precipitable water      ! prw: precipitable water
168      real prw(klon)      real prw(klon)
# Line 210  contains Line 173  contains
173      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
174    
175      INTEGER kmax, lmax      INTEGER kmax, lmax
176      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
177      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
178      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
179    
180      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
181      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
182      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
183    
184      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 223  contains Line 186  contains
186      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
187    
188      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
189      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
190    
191      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
192      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
193      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
194    
195      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
196      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
197           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
198           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 256  contains Line 219  contains
219           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
220           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
221    
222      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
223    
224      ! Variables propres a la physique      ! Variables propres a la physique
225    
226      INTEGER, save:: radpas      INTEGER, save:: radpas
227      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
228      ! "physiq".)      ! "physiq".
229    
230      REAL radsol(klon)      REAL radsol(klon)
231      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
232    
233      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
234    
235      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
236    
237      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
238      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
239    
240      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap                 ! evaporation  
241      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
242      SAVE fluxlat      SAVE fluxlat
243    
244      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
245      SAVE fqsurf                 ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
246    
247      REAL qsol(klon)      REAL, save:: qsol(klon)
248      SAVE qsol                  ! hauteur d'eau dans le sol      ! column-density of water in soil, in kg m-2
249    
250      REAL fsnow(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      SAVE fsnow                  ! epaisseur neigeuse      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface
252        REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface
253    
254      REAL falbe(klon, nbsrf)      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
     SAVE falbe                  ! albedo par type de surface  
     REAL falblw(klon, nbsrf)  
     SAVE falblw                 ! albedo par type de surface  
   
     ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :  
255      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
256      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
257      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 312  contains Line 266  contains
266      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
267    
268      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
269      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
270    
271      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
272      SAVE run_off_lic_0      SAVE run_off_lic_0
273      !KE43      !KE43
274      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
275    
276      REAL bas, top             ! cloud base and top levels      REAL Ma(klon, llm) ! undilute upward mass flux
     SAVE bas  
     SAVE top  
   
     REAL Ma(klon, llm)        ! undilute upward mass flux  
277      SAVE Ma      SAVE Ma
278      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
279      SAVE qcondc      SAVE qcondc
280      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
281      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd       ! sb  
282    
283      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
284    
# Line 340  contains Line 287  contains
287      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
288      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
289    
290      !AA  Pour phytrac      ! Pour phytrac :
291      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
292      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
293      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
294      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
295      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
296      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
297      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
298      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
299    
300      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 359  contains Line 306  contains
306      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
307      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
308    
309      !AA      REAL, save:: rain_fall(klon)
310      REAL rain_fall(klon) ! pluie      ! liquid water mass flux (kg/m2/s), positive down
311      REAL snow_fall(klon) ! neige  
312      save snow_fall, rain_fall      REAL, save:: snow_fall(klon)
313      !IM cf FH pour Tiedtke 080604      ! solid water mass flux (kg/m2/s), positive down
314    
315      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
316    
317      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
318      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
319      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
320      SAVE dlw      SAVE dlw
321      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
322      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 378  contains Line 326  contains
326      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
327      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
328    
329      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
330      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
331    
332      ! Conditions aux limites      ! Conditions aux limites
333    
334      INTEGER julien      INTEGER julien
   
335      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
336      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
337      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
338      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total
339        REAL, save:: albsollw(klon) ! albedo du sol total
     SAVE pctsrf                 ! sous-fraction du sol  
     REAL albsol(klon)  
     SAVE albsol                 ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw                 ! albedo du sol total  
   
340      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
341    
342      ! Declaration des procedures appelees      ! Declaration des procedures appelees
343    
344      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL nuage ! calculer les proprietes radiatives
345      EXTERNAL ajsec     ! ajustement sec      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL clmain    ! couche limite  
     !KE43  
     EXTERNAL conema3  ! convect4.3  
     EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)  
     EXTERNAL nuage     ! calculer les proprietes radiatives  
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
346    
347      ! Variables locales      ! Variables locales
348    
349      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
350      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
351    
352      save rnebcon, clwcon      REAL rhcl(klon, llm) ! humiditi relative ciel clair
353        REAL dialiq(klon, llm) ! eau liquide nuageuse
354      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL diafra(klon, llm) ! fraction nuageuse
355      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
356      REAL diafra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
357      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldtau(klon, llm) ! epaisseur optique
358      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldemi(klon, llm) ! emissivite infrarouge
359      REAL cldtau(klon, llm)  ! epaisseur optique  
360      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
361        REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
362      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
363      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
     REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u  
     REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v  
364    
365      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
366      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
367      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
368      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
369    
370      REAL heat(klon, llm)    ! chauffage solaire      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
371      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! les variables soient r\'emanentes.
372      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
373      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
374      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
375      real sollwdown(klon)    ! downward LW flux at surface      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
376      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
377        REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
378        real, save:: sollwdown(klon) ! downward LW flux at surface
379        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
380      REAL albpla(klon)      REAL albpla(klon)
381      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
382      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
383      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla
384      !                      sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
385    
386      INTEGER itaprad      INTEGER itaprad
387      SAVE itaprad      SAVE itaprad
388    
389      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
390      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
391    
392      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
393      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
394    
395      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
396    
397      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
398      REAL zdtime ! pas de temps du rayonnement (s)      real longi
     real zlongi  
   
399      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
400      REAL za, zb      REAL za, zb
401      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zcor
402      real zqsat(klon, llm)      real zqsat(klon, llm)
403      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
404      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup=234.0)  
   
405      REAL zphi(klon, llm)      REAL zphi(klon, llm)
406    
407      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
408    
409      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
410      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
411      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
412      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
413      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
414      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
415      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
416      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
417      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
418      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
419      ! Grdeurs de sorties      ! Grdeurs de sorties
420      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
421      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
422      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
423      REAL s_trmb3(klon)      REAL s_trmb3(klon)
424    
425      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
426    
427      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
428      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
429      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
430      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL cape(klon) ! CAPE
     REAL cape(klon)           ! CAPE  
431      SAVE cape      SAVE cape
432    
433      REAL pbase(klon)          ! cloud base pressure      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     SAVE pbase  
     REAL bbase(klon)          ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon)          ! flag fonctionnement de convect  
     INTEGER iflagctrl(klon)          ! flag fonctionnement de convect  
     ! -- convect43:  
     INTEGER ntra              ! nb traceurs pour convect4.3  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
434    
435      ! Variables du changement      ! Variables du changement
436    
437      ! con: convection      ! con: convection
438      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
439      ! ajs: ajustement sec      ! ajs: ajustement sec
440      ! eva: evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
441      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
442      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
443      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
444      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)
# Line 530  contains Line 446  contains
446      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
447      REAL rneb(klon, llm)      REAL rneb(klon, llm)
448    
449      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
450      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
451      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
452      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
453      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
454      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
   
     INTEGER ibas_con(klon), itop_con(klon)  
455    
456      SAVE ibas_con, itop_con      INTEGER, save:: ibas_con(klon), itop_con(klon)
457    
458      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
459      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 553  contains Line 467  contains
467      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
468      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
469    
470      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
471      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
472      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
473    
474      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
475      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
476      real, save:: facttemps      real:: facttemps = 1.e-4
477      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
478      real facteur      real facteur
479    
480      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
481      logical ptconv(klon, llm)      logical ptconv(klon, llm)
482    
483      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en s\'erie :
484    
485      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
486      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
487      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
488        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
489    
490      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
491    
# Line 585  contains Line 494  contains
494      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
495      REAL aam, torsfc      REAL aam, torsfc
496    
497      REAL dudyn(iim+1, jjm + 1, llm)      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
498    
499      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      INTEGER, SAVE:: nid_ins
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
     INTEGER, SAVE:: nid_day, nid_ins  
500    
501      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
502      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
503      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
504      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
505    
     REAL zsto  
   
     character(len=20) modname  
     character(len=80) abort_message  
     logical ok_sync  
506      real date0      real date0
507    
508      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
509      REAL ztsol(klon)      REAL ztsol(klon)
510      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_ec
511      REAL      d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
512      REAL      fs_bound, fq_bound      REAL zero_v(klon)
513      SAVE      d_h_vcol_phy      CHARACTER(LEN = 20) tit
514      REAL      zero_v(klon)      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
515      CHARACTER(LEN=15) ztit      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
516      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.  
517      SAVE      ip_ebil      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
     DATA      ip_ebil/0/  
     INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics  
     !+jld ec_conser  
     REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique  
518      REAL ZRCPD      REAL ZRCPD
519      !-jld ec_conser  
520      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
521      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
522      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
523      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
524      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille  
525      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      ! Aerosol effects:
526      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]  
527        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
528      REAL sulfate_pi(klon, llm)  
529      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      REAL, save:: sulfate_pi(klon, llm)
530      SAVE sulfate_pi      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
531    
532      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
533      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
534    
535      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
536      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
537    
538      ! Aerosol optical properties      ! Aerosol optical properties
539      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
540      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
541    
542      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
543      ! ok_ade=T -ADE=topswad-topsw      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
544    
545      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL aerindex(klon) ! POLDER aerosol index
     ! ok_aie=T ->  
     !        ok_ade=T -AIE=topswai-topswad  
     !        ok_ade=F -AIE=topswai-topsw  
546    
547      REAL aerindex(klon)       ! POLDER aerosol index      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
548        LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
549    
550      ! Parameters      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
551      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
552      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      ! B). They link cloud droplet number concentration to aerosol mass
553        ! concentration.
554    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
555      SAVE u10m      SAVE u10m
556      SAVE v10m      SAVE v10m
557      SAVE t2m      SAVE t2m
558      SAVE q2m      SAVE q2m
559      SAVE ffonte      SAVE ffonte
560      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
561      SAVE rain_con      SAVE rain_con
562      SAVE snow_con      SAVE snow_con
563      SAVE topswai      SAVE topswai
# Line 674  contains Line 566  contains
566      SAVE solswad      SAVE solswad
567      SAVE d_u_con      SAVE d_u_con
568      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
569    
570      real zmasse(klon, llm)      real zmasse(klon, llm)
571      ! (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)
572    
573      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
574    
575        namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
576             facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
577             ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals
578    
579      !----------------------------------------------------------------      !----------------------------------------------------------------
580    
581      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
582      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
583         DO i=1, klon           'eaux vapeur et liquide sont indispensables', 1)
           zero_v(i)=0.  
        END DO  
     END IF  
     ok_sync=.TRUE.  
     IF (nqmx  <  2) THEN  
        abort_message = 'eaux vapeur et liquide sont indispensables'  
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
584    
585      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
586         !  initialiser         ! initialiser
587         u10m=0.         u10m = 0.
588         v10m=0.         v10m = 0.
589         t2m=0.         t2m = 0.
590         q2m=0.         q2m = 0.
591         ffonte=0.         ffonte = 0.
592         fqcalving=0.         fqcalving = 0.
593         piz_ae(:, :, :)=0.         piz_ae = 0.
594         tau_ae(:, :, :)=0.         tau_ae = 0.
595         cg_ae(:, :, :)=0.         cg_ae = 0.
596         rain_con(:)=0.         rain_con = 0.
597         snow_con(:)=0.         snow_con = 0.
598         bl95_b0=0.         topswai = 0.
599         bl95_b1=0.         topswad = 0.
600         topswai(:)=0.         solswai = 0.
601         topswad(:)=0.         solswad = 0.
602         solswai(:)=0.  
603         solswad(:)=0.         d_u_con = 0.
604           d_v_con = 0.
605         d_u_con = 0.0         rnebcon0 = 0.
606         d_v_con = 0.0         clwcon0 = 0.
607         rnebcon0 = 0.0         rnebcon = 0.
608         clwcon0 = 0.0         clwcon = 0.
609         rnebcon = 0.0  
610         clwcon = 0.0         pblh =0. ! Hauteur de couche limite
611           plcl =0. ! Niveau de condensation de la CLA
612         pblh   =0.        ! Hauteur de couche limite         capCL =0. ! CAPE de couche limite
613         plcl   =0.        ! Niveau de condensation de la CLA         oliqCL =0. ! eau_liqu integree de couche limite
614         capCL  =0.        ! CAPE de couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
615         oliqCL =0.        ! eau_liqu integree de couche limite         pblt =0. ! T a la Hauteur de couche limite
616         cteiCL =0.        ! cloud top instab. crit. couche limite         therm =0.
617         pblt   =0.        ! T a la Hauteur de couche limite         trmb1 =0. ! deep_cape
618         therm  =0.         trmb2 =0. ! inhibition
619         trmb1  =0.        ! deep_cape         trmb3 =0. ! Point Omega
620         trmb2  =0.        ! inhibition  
621         trmb3  =0.        ! Point Omega         IF (if_ebil >= 1) d_h_vcol_phy = 0.
622    
623         IF (if_ebil >= 1) d_h_vcol_phy=0.         iflag_thermals = 0
624           nsplit_thermals = 1
625         ! appel a la lecture du run.def physique         print *, "Enter namelist 'physiq_nml'."
626           read(unit=*, nml=physiq_nml)
627         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         write(unit_nml, nml=physiq_nml)
628              ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
629              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &         call conf_phys
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
630    
631         ! Initialiser les compteurs:         ! Initialiser les compteurs:
632    
633         frugs = 0.         frugs = 0.
634         itap = 0         itap = 0
635         itaprad = 0         itaprad = 0
636         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
637              seaice, fqsurf, qsol, fsnow, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &
638              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
639              dlw, radsol, frugs, agesno, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
640              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              run_off_lic_0, sig1, w01)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
641    
642         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
643         q2(:, :, :)=1.e-8         q2 = 1e-8
644    
645         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
646    
647         ! on remet le calendrier a zero         ! on remet le calendrier a zero
648         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
649    
650         PRINT *, 'cycle_diurne = ', cycle_diurne         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
651    
652         IF(ocean.NE.'force ') THEN         IF (dtphys * radpas > 21600. .AND. cycle_diurne) THEN
653            ok_ocean=.TRUE.            print *, "Au minimum 4 appels par jour si cycle diurne"
654              call abort_gcm('physiq', &
655                   "Nombre d'appels au rayonnement insuffisant", 1)
656         ENDIF         ENDIF
657    
658         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         ! Initialisation pour le sch\'ema de convection d'Emanuel :
             ok_region)  
   
        IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN  
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        print *,"Clef pour la convection, iflag_con=", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
   
        ! Initialisation pour la convection de K.E. (sb):  
659         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
660              ibas_con = 1
661            print *,"*** Convection de Kerry Emanuel 4.3  "            itop_con = 1
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
662         ENDIF         ENDIF
663    
664         IF (ok_orodr) THEN         IF (ok_orodr) THEN
665            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
666            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(paprs, play)
667         else         else
668            rugoro = 0.            rugoro = 0.
669         ENDIF         ENDIF
670    
671         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
672         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
673    
674         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
675         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
676         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
677         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
678         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
679    
680         ! Initialiser le couplage si necessaire         ! Initialisation des sorties
681    
682         npas = 0         call ini_histins(dtphys, ok_instan, nid_ins)
683         nexca = 0         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
684           ! Positionner date0 pour initialisation de ORCHIDEE
685         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *, 'physiq date0: ', date0
   
        !   Initialisation des sorties  
   
        call ini_histhf(pdtphys, nid_hf, nid_hf3d)  
        call ini_histday(pdtphys, ok_journe, nid_day, nqmx)  
        call ini_histins(pdtphys, ok_instan, nid_ins)  
        CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)  
        !XXXPB Positionner date0 pour initialisation de ORCHIDEE  
        WRITE(*, *) 'physiq date0 : ', date0  
686      ENDIF test_firstcal      ENDIF test_firstcal
687    
688      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
689        ! u, v, t, qx:
690        t_seri = t
691        u_seri = u
692        v_seri = v
693        q_seri = qx(:, :, ivap)
694        ql_seri = qx(:, :, iliq)
695        tr_seri = qx(:, :, 3: nqmx)
696    
697      DO i = 1, klon      ztsol = sum(ftsol * pctsrf, dim = 2)
        d_ps(i) = 0.0  
     ENDDO  
     DO k = 1, llm  
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
     da=0.  
     mp=0.  
     phi(:, :, :)=0.  
   
     ! Ne pas affecter les valeurs entrees 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  
698    
699      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
700         ztit='after dynamic'         tit = 'after dynamics'
701         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
702              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
703              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)         ! Comme les tendances de la physique sont ajout\'es dans la
704         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !  dynamique, la variation d'enthalpie par la dynamique devrait
705         !     on devrait avoir que la variation d'entalpie par la dynamique         !  \^etre \'egale \`a la variation de la physique au pas de temps
706         !     est egale a la variation de la physique au pas de temps precedent.         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
707         !     Donc la somme de ces 2 variations devrait etre nulle.         !  nulle.
708         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
709              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
710              , zero_v, zero_v, zero_v, ztsol &              d_qt, 0.)
             , d_h_vcol+d_h_vcol_phy, d_qt, 0. &  
             , fs_bound, fq_bound )  
711      END IF      END IF
712    
713      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
714      IF (ancien_ok) THEN      IF (ancien_ok) THEN
715         DO k = 1, llm         DO k = 1, llm
716            DO i = 1, klon            DO i = 1, klon
717               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
718               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
719            ENDDO            ENDDO
720         ENDDO         ENDDO
721      ELSE      ELSE
722         DO k = 1, llm         DO k = 1, llm
723            DO i = 1, klon            DO i = 1, klon
724               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
725               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
726            ENDDO            ENDDO
727         ENDDO         ENDDO
728         ancien_ok = .TRUE.         ancien_ok = .TRUE.
729      ENDIF      ENDIF
730    
731      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
732      DO k = 1, llm      DO k = 1, llm
733         DO i = 1, klon         DO i = 1, klon
734            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
735         ENDDO         ENDDO
736      ENDDO      ENDDO
737    
738      ! Verifier les temperatures      ! Check temperatures:
   
739      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
740    
741      ! Incrementer le compteur de la physique      ! Incrémenter le compteur de la physique
   
742      itap = itap + 1      itap = itap + 1
743      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
744      if (julien == 0) julien = 360      if (julien == 0) julien = 360
745    
746      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
747    
748      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Prescrire l'ozone :
749      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      wo = ozonecm(REAL(julien), paprs)
750    
751      if (nqmx >= 5) then      ! \'Evaporation de l'eau liquide nuageuse :
752         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3      DO k = 1, llm
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Re-evaporer l'eau liquide nuageuse  
   
     DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse  
753         DO i = 1, klon         DO i = 1, klon
754            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
755            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
756            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
757            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
758         ENDDO         ENDDO
759      ENDDO      ENDDO
760        ql_seri = 0.
761    
762      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
763         ztit='after reevap'         tit = 'after reevap'
764         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
765              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
766              , 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, &
767         call diagphy(airephy, ztit, ip_ebil &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             , 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 )  
   
768      END IF      END IF
769    
770      ! Appeler la diffusion verticale (programme de couche limite)      frugs = MAX(frugs, 0.000015)
771        zxrugs = sum(frugs * pctsrf, dim = 2)
     DO i = 1, klon  
        zxrugs(i) = 0.0  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
772    
773      ! calculs necessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
774        ! la surface.
775    
776      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
777      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
778         zdtime = pdtphys * REAL(radpas)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)  
779      ELSE      ELSE
780         rmu0 = -999.999         mu0 = -999.999
781      ENDIF      ENDIF
782    
783      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
784      albsol(:)=0.      albsol = sum(falbe * pctsrf, dim = 2)
785      albsollw(:)=0.      albsollw = sum(falblw * pctsrf, dim = 2)
786      DO nsrf = 1, nbsrf  
787         DO i = 1, klon      ! R\'epartition sous maille des flux longwave et shortwave
788            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
789            albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
790         ENDDO      forall (nsrf = 1: nbsrf)
791      ENDDO         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
792                * (ztsol - ftsol(:, nsrf))
793      !     Repartition sous maille des flux LW et SW         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
794      ! Repartition du longwave par sous-surface linearisee      END forall
   
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           fsollw(i, nsrf) = sollw(i) &  
                + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))  
           fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))  
        ENDDO  
     ENDDO  
795    
796      fder = dlw      fder = dlw
797    
798      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
799           t_seri, q_seri, u_seri, v_seri, &  
800           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
801           ok_veget, ocean, npas, nexca, ftsol, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, &
802           soil_model, cdmmax, cdhmax, &           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
803           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &
804           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &
805           fluxlat, rain_fall, snow_fall, &           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
806           fsolsw, fsollw, sollwdown, fder, &           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &
807           rlon, rlat, cuphy, cvphy, frugs, &           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
808           firstcal, lafin, agesno, rugoro, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)
809           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &  
810           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &      ! Incr\'ementation des flux
811           q2, dsens, devap, &  
812           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &      zxfluxt = 0.
813           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxq = 0.
814           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxu = 0.
815           fqcalving, ffonte, run_off_lic_0, &      zxfluxv = 0.
          fluxo, fluxg, tslab, seaice)  
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
816      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
817         DO k = 1, llm         DO k = 1, llm
818            DO i = 1, klon            DO i = 1, klon
819               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
820                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
821               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
822                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)
              zxfluxu(i, k) = zxfluxu(i, k) +  &  
                   fluxu(i, k, nsrf) * pctsrf( i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) +  &  
                   fluxv(i, k, nsrf) * pctsrf( i, nsrf)  
823            END DO            END DO
824         END DO         END DO
825      END DO      END DO
826      DO i = 1, klon      DO i = 1, klon
827         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
828         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
829         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
830      ENDDO      ENDDO
831    
# Line 1090  contains Line 839  contains
839      ENDDO      ENDDO
840    
841      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
842         ztit='after clmain'         tit = 'after clmain'
843         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
844              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
845              , 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, &
846         call diagphy(airephy, ztit, ip_ebil &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             , 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 )  
847      END IF      END IF
848    
849      ! Incrementer la temperature du sol      ! Update surface temperature:
850    
851      DO i = 1, klon      DO i = 1, klon
852         zxtsol(i) = 0.0         zxtsol(i) = 0.
853         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
854    
855         zt2m(i) = 0.0         zt2m(i) = 0.
856         zq2m(i) = 0.0         zq2m(i) = 0.
857         zu10m(i) = 0.0         zu10m(i) = 0.
858         zv10m(i) = 0.0         zv10m(i) = 0.
859         zxffonte(i) = 0.0         zxffonte(i) = 0.
860         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
861    
862         s_pblh(i) = 0.0         s_pblh(i) = 0.
863         s_lcl(i) = 0.0         s_lcl(i) = 0.
864         s_capCL(i) = 0.0         s_capCL(i) = 0.
865         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
866         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
867         s_pblT(i) = 0.0         s_pblT(i) = 0.
868         s_therm(i) = 0.0         s_therm(i) = 0.
869         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
870         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
871         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
872    
873         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
874              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
875              THEN              'physiq : probl\`eme sous surface au point ', i, &
876            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &              pctsrf(i, 1 : nbsrf)
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
877      ENDDO      ENDDO
878      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
879         DO i = 1, klon         DO i = 1, klon
# Line 1143  contains Line 886  contains
886            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
887            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
888            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
889            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
890                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
891            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
892            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)
# Line 1158  contains Line 901  contains
901         ENDDO         ENDDO
902      ENDDO      ENDDO
903    
904      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :
   
905      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
906         DO i = 1, klon         DO i = 1, klon
907            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
908    
909            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
910            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
911            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
912            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
913            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
914            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
915                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
916            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
917            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
918            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
919            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
920            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
921            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
922            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
923            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
924            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
925            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
926         ENDDO         ENDDO
927      ENDDO      ENDDO
928    
929      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
930    
931      DO i = 1, klon      DO i = 1, klon
932         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
933      ENDDO      ENDDO
934    
935        IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
936    
937      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
938    
939      DO k = 1, llm      if (iflag_con == 2) then
940         DO i = 1, klon         conv_q = d_q_dyn + d_q_vdf / dtphys
941            conv_q(i, k) = d_q_dyn(i, k)  &         conv_t = d_t_dyn + d_t_vdf / dtphys
942                 + d_q_vdf(i, k)/pdtphys         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
943            conv_t(i, k) = d_t_dyn(i, k)  &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
944                 + d_t_vdf(i, k)/pdtphys              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
945         ENDDO              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
946      ENDDO              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
947      IF (check) THEN              kdtop, pmflxr, pmflxs)
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon=", za  
     ENDIF  
     zx_ajustq = .FALSE.  
     IF (iflag_con == 2) zx_ajustq=.TRUE.  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
     IF (iflag_con == 1) THEN  
        stop 'reactiver le call conlmd dans physiq.F'  
     ELSE IF (iflag_con == 2) THEN  
        CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &  
             conv_t, conv_q, zxfluxq(1, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, &  
             pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
948         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
949         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
950         DO i = 1, klon         ibas_con = llm + 1 - kcbot
951            ibas_con(i) = llm+1 - kcbot(i)         itop_con = llm + 1 - kctop
952            itop_con(i) = llm+1 - kctop(i)      else
953         ENDDO         ! iflag_con >= 3
     ELSE IF (iflag_con >= 3) THEN  
        ! nb of tracers for the KE convection:  
        ! MAF la partie traceurs est faite dans phytrac  
        ! on met ntra=1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.  
        ntra = 1  
        ! Schema de convection modularise et vectorise:  
        ! (driver commun aux versions 3 et 4)  
   
        IF (ok_cvl) THEN ! new driver for convectL  
           CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, &  
                Ma, cape, tvp, iflagctrl, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
   
           clwcon0=qcondc  
           pmfu=upwd+dnwd  
        ELSE ! ok_cvl  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
954    
955         IF (.NOT. ok_gust) THEN         da = 0.
956            do i = 1, klon         mp = 0.
957               wd(i)=0.0         phi = 0.
958            enddo         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
959                w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
960                ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
961                qcondc, wd, pmflxr, pmflxs, da, phi, mp)
962           clwcon0 = qcondc
963           mfu = upwd + dnwd
964           IF (.NOT. ok_gust) wd = 0.
965    
966           IF (thermcep) THEN
967              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
968              zqsat = zqsat / (1. - retv * zqsat)
969           ELSE
970              zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
971         ENDIF         ENDIF
972    
973         ! Calcul des proprietes des nuages convectifs         ! Properties of convective clouds
974           clwcon0 = fact_cldcon * clwcon0
975         DO k = 1, llm         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
976            DO i = 1, klon              rnebcon0)
977               zx_t = t_seri(i, k)  
978               IF (thermcep) THEN         mfd = 0.
979                  zdelta = MAX(0., SIGN(1., rtt-zx_t))         pen_u = 0.
980                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)         pen_d = 0.
981                  zx_qs  = MIN(0.5, zx_qs)         pde_d = 0.
982                  zcor   = 1./(1.-retv*zx_qs)         pde_u = 0.
983                  zx_qs  = zx_qs*zcor      END if
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/pplay(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/pplay(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k)=zx_qs  
           ENDDO  
        ENDDO  
   
        !   calcul des proprietes des nuages convectifs  
        clwcon0=fact_cldcon*clwcon0  
        call clouds_gno &  
             (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)  
     ELSE  
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     ENDIF  
984    
985      DO k = 1, llm      DO k = 1, llm
986         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 992  contains
992      ENDDO      ENDDO
993    
994      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
995         ztit='after convect'         tit = 'after convect'
996         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
997              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
998              , 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, &
999         call diagphy(airephy, ztit, ip_ebil &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)
             , 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 )  
1000      END IF      END IF
1001    
1002      IF (check) THEN      IF (check) THEN
1003         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1004         print *,"aprescon=", za         print *, "aprescon = ", za
1005         zx_t = 0.0         zx_t = 0.
1006         za = 0.0         za = 0.
1007         DO i = 1, klon         DO i = 1, klon
1008            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1009            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1010                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1011         ENDDO         ENDDO
1012         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1013         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1014      ENDIF      ENDIF
1015      IF (zx_ajustq) THEN  
1016         DO i = 1, klon      IF (iflag_con == 2) THEN
1017            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1018         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &  
                /z_apres(i)  
        ENDDO  
1019         DO k = 1, llm         DO k = 1, llm
1020            DO i = 1, klon            DO i = 1, klon
1021               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1022                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1023               ENDIF               ENDIF
1024            ENDDO            ENDDO
1025         ENDDO         ENDDO
1026      ENDIF      ENDIF
     zx_ajustq=.FALSE.  
1027    
1028      ! Convection seche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1029    
1030      d_t_ajs=0.      d_t_ajs = 0.
1031      d_u_ajs=0.      d_u_ajs = 0.
1032      d_v_ajs=0.      d_v_ajs = 0.
1033      d_q_ajs=0.      d_q_ajs = 0.
1034      fm_therm=0.      fm_therm = 0.
1035      entr_therm=0.      entr_therm = 0.
1036    
1037      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1038           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1039           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
     if(iflag_thermals < 0) then  
        !  Rien  
        IF(prt_level>9)print *,'pas de convection'  
     else if(iflag_thermals == 0) then  
        !  Ajustement sec  
        IF(prt_level>9)print *,'ajsec'  
        CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)  
1040         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1041         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1042      else      else
1043         !  Thermiques         ! Thermiques
1044         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1045              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
        call calltherm(pdtphys &  
             , pplay, paprs, pphi &  
             , u_seri, v_seri, t_seri, q_seri &  
             , d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs &  
             , fm_therm, entr_therm)  
1046      endif      endif
1047    
1048      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1049         ztit='after dry_adjust'         tit = 'after dry_adjust'
1050         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1051              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
1052      END IF      END IF
1053    
1054      !  Caclul des ratqs      ! Caclul des ratqs
1055    
1056      !   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
1057      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1058      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1059         do k=1, llm         do k = 1, llm
1060            do i=1, klon            do i = 1, klon
1061               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1062                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1063                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1064               else               else
1065                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1066               endif               endif
1067            enddo            enddo
1068         enddo         enddo
1069      endif      endif
1070    
1071      !   ratqs stables      ! ratqs stables
1072      do k=1, llm      do k = 1, llm
1073         do i=1, klon         do i = 1, klon
1074            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1075                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1076         enddo         enddo
1077      enddo      enddo
1078    
1079      !  ratqs final      ! ratqs final
1080      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1081         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1082         !   ratqs final         ! ratqs final
1083         !   1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1084         !   relaxation des ratqs         ! relaxation des ratqs
1085         facteur=exp(-pdtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
1086         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs, ratqsc)
        ratqs=max(ratqs, ratqsc)  
1087      else      else
1088         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1089         ratqs=ratqss         ratqs = ratqss
1090      endif      endif
1091    
1092      ! Appeler le processus de condensation a grande echelle      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1093      ! et le processus de precipitation           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1094      CALL fisrtilp(pdtphys, paprs, pplay, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1095           t_seri, q_seri, ptconv, ratqs, &           psfl, rhcl)
          d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &  
          rain_lsc, snow_lsc, &  
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1096    
1097      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1098      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1464  contains Line 1106  contains
1106         ENDDO         ENDDO
1107      ENDDO      ENDDO
1108      IF (check) THEN      IF (check) THEN
1109         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1110         print *,"apresilp=", za         print *, "apresilp = ", za
1111         zx_t = 0.0         zx_t = 0.
1112         za = 0.0         za = 0.
1113         DO i = 1, klon         DO i = 1, klon
1114            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1115            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1116                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1117         ENDDO         ENDDO
1118         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1119         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1120      ENDIF      ENDIF
1121    
1122      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1123         ztit='after fisrt'         tit = 'after fisrt'
1124         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1125              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1126              , 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, &
1127         call diagphy(airephy, ztit, ip_ebil &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec)
             , 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 )  
1128      END IF      END IF
1129    
1130      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1131    
1132      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1133    
1134      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1135         snow_tiedtke=0.         ! seulement pour Tiedtke
1136           snow_tiedtke = 0.
1137         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1138            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1139         else         else
1140            rain_tiedtke=0.            rain_tiedtke = 0.
1141            do k=1, llm            do k = 1, llm
1142               do i=1, klon               do i = 1, klon
1143                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1144                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1145                          *zmasse(i, k)                          *zmasse(i, k)
1146                  endif                  endif
1147               enddo               enddo
# Line 1510  contains Line 1149  contains
1149         endif         endif
1150    
1151         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1152         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1153              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1154         DO k = 1, llm         DO k = 1, llm
1155            DO i = 1, klon            DO i = 1, klon
1156               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1157                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1158                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1159               ENDIF               ENDIF
1160            ENDDO            ENDDO
1161         ENDDO         ENDDO
   
1162      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1163         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1164         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1165         ! facttemps         ! d'un facteur facttemps.
1166         facteur = pdtphys *facttemps         facteur = dtphys * facttemps
1167         do k=1, llm         do k = 1, llm
1168            do i=1, klon            do i = 1, klon
1169               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1170               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1171                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1172                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1173                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1174               endif               endif
1175            enddo            enddo
1176         enddo         enddo
1177    
1178         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1179         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1180         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1181      ENDIF      ENDIF
1182    
1183      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1184    
1185      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1186         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1187         DO k = 1, llm         DO k = 1, llm
1188            DO i = 1, klon            DO i = 1, klon
1189               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1190                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1191                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1192               ENDIF               ENDIF
# Line 1559  contains Line 1195  contains
1195      ENDIF      ENDIF
1196    
1197      ! Precipitation totale      ! Precipitation totale
   
1198      DO i = 1, klon      DO i = 1, klon
1199         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1200         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1201      ENDDO      ENDDO
1202    
1203      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1204         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1205         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           d_qt, d_ec)
             , 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  
   
     ! Calculer l'humidite relative pour diagnostique  
1206    
1207        ! Humidit\'e relative pour diagnostic :
1208      DO k = 1, llm      DO k = 1, llm
1209         DO i = 1, klon         DO i = 1, klon
1210            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1211            IF (thermcep) THEN            IF (thermcep) THEN
1212               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
1213               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = MIN(0.5, zx_qs)
1214               zx_qs  = MIN(0.5, zx_qs)               zcor = 1./(1.-retv*zx_qs)
1215               zcor   = 1./(1.-retv*zx_qs)               zx_qs = zx_qs*zcor
              zx_qs  = zx_qs*zcor  
1216            ELSE            ELSE
1217               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1218                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1219               ELSE               ELSE
1220                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1221               ENDIF               ENDIF
1222            ENDIF            ENDIF
1223            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1224            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1225         ENDDO         ENDDO
1226      ENDDO      ENDDO
1227      !jq - introduce the aerosol direct and first indirect radiative forcings  
1228      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1229      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1230         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1231         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1232         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1233    
1234         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1235         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1236      ELSE      ELSE
1237         tau_ae(:, :, :)=0.0         tau_ae = 0.
1238         piz_ae(:, :, :)=0.0         piz_ae = 0.
1239         cg_ae(:, :, :)=0.0         cg_ae = 0.
1240      ENDIF      ENDIF
1241    
1242      ! Calculer les parametres optiques des nuages et quelques      ! Param\`etres optiques des nuages et quelques param\`etres pour
1243      ! parametres pour diagnostiques:      ! diagnostics :
   
1244      if (ok_newmicro) then      if (ok_newmicro) then
1245         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1246              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1247              cldh, cldl, cldm, cldt, cldq, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             flwp, fiwp, flwc, fiwc, &  
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1248      else      else
1249         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1250              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1251              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1252      endif      endif
1253    
     ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.  
   
1254      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1255           ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1256         DO i = 1, klon         DO i = 1, klon
1257            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
1258                 + falbe(i, is_lic) * pctsrf(i, is_lic) &                 + falbe(i, is_lic) * pctsrf(i, is_lic) &
# Line 1646  contains Line 1263  contains
1263                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1264                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1265         ENDDO         ENDDO
1266         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1267         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &
1268              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1269              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1270              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1271              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1272              topsw, toplw, solsw, sollw, &              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
             sollwdown, &  
             topsw0, toplw0, solsw0, sollw0, &  
             lwdn0, lwdn, lwup0, lwup,  &  
             swdn0, swdn, swup0, swup, &  
             ok_ade, ok_aie, & ! new for aerosol radiative effects  
             tau_ae, piz_ae, cg_ae, &  
             topswad, solswad, &  
             cldtaupi, &  
             topswai, solswai)  
1273         itaprad = 0         itaprad = 0
1274      ENDIF      ENDIF
1275    
1276      itaprad = itaprad + 1      itaprad = itaprad + 1
1277    
1278      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1279    
1280      DO k = 1, llm      DO k = 1, llm
1281         DO i = 1, klon         DO i = 1, klon
1282            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * pdtphys/86400.  
1283         ENDDO         ENDDO
1284      ENDDO      ENDDO
1285    
1286      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1287         ztit='after rad'         tit = 'after rad'
1288         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1289              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1290              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1291         call diagphy(airephy, ztit, ip_ebil &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             , topsw, toplw, solsw, sollw, zero_v &  
             , zero_v, zero_v, zero_v, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1292      END IF      END IF
1293    
1294      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1295      DO i = 1, klon      DO i = 1, klon
1296         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1297         zxsnow(i) = 0.0         zxsnow(i) = 0.
1298      ENDDO      ENDDO
1299      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1300         DO i = 1, klon         DO i = 1, klon
# Line 1700  contains Line 1303  contains
1303         ENDDO         ENDDO
1304      ENDDO      ENDDO
1305    
1306      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1307    
1308      DO i = 1, klon      DO i = 1, klon
1309         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1310      ENDDO      ENDDO
1311    
1312      !mod deb lott(jan95)      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1313    
1314      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1315         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1316         igwd=0         igwd = 0
1317         DO i=1, klon         DO i = 1, klon
1318            itest(i)=0            itest(i) = 0
1319            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1320               itest(i)=1               itest(i) = 1
1321               igwd=igwd+1               igwd = igwd + 1
1322               idx(igwd)=i               idx(igwd) = i
1323            ENDIF            ENDIF
1324         ENDDO         ENDDO
1325    
1326         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1327              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1328              igwd, idx, itest, &              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1329    
1330         !  ajout des tendances         ! ajout des tendances
1331         DO k = 1, llm         DO k = 1, llm
1332            DO i = 1, klon            DO i = 1, klon
1333               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)
# Line 1740  contains Line 1338  contains
1338      ENDIF      ENDIF
1339    
1340      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1341           ! S\'election des points pour lesquels le sch\'ema est actif :
1342         !  selection des points pour lesquels le shema est actif:         igwd = 0
1343         igwd=0         DO i = 1, klon
1344         DO i=1, klon            itest(i) = 0
1345            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1346            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1347               itest(i)=1               igwd = igwd + 1
1348               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1349            ENDIF            ENDIF
1350         ENDDO         ENDDO
1351    
1352         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1353              rlat, zmea, zstd, zpic, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
             itest, &  
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrli, zvstrli, &  
1354              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1355    
1356         !  ajout des tendances         ! Ajout des tendances :
1357         DO k = 1, llm         DO k = 1, llm
1358            DO i = 1, klon            DO i = 1, klon
1359               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1767  contains Line 1361  contains
1361               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
1362            ENDDO            ENDDO
1363         ENDDO         ENDDO
1364        ENDIF
1365    
1366      ENDIF ! fin de test sur ok_orolf      ! Stress n\'ecessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
1367    
1368      DO i = 1, klon      DO i = 1, klon
1369         zustrph(i)=0.         zustrph(i) = 0.
1370         zvstrph(i)=0.         zvstrph(i) = 0.
1371      ENDDO      ENDDO
1372      DO k = 1, llm      DO k = 1, llm
1373         DO i = 1, klon         DO i = 1, klon
1374            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1375            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)                 * zmasse(i, k)
1376              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1377                   * zmasse(i, k)
1378         ENDDO         ENDDO
1379      ENDDO      ENDDO
1380    
1381      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1382             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1383    
1384      CALL aaam_bud(27, klon, llm, gmtime, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1385           ra, rg, romega, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1386           rlat, rlon, pphis, &           d_qt, d_ec)
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
          aam, torsfc)  
1387    
1388      IF (if_ebil >= 2) THEN      ! Calcul des tendances traceurs
1389         ztit='after orography'      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1390         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1391              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1392              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           upwd, dnwd, tr_seri, zmasse)
     END IF  
1393    
1394      ! Calcul  des tendances traceurs      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1395      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nqmx-2, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1396           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
          pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &  
          frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &  
          diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri, zmasse)  
   
     IF (offline) THEN  
        call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &  
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)  
     ENDIF  
1397    
1398      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1399      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1820  contains Line 1401  contains
1401    
1402      ! diag. bilKP      ! diag. bilKP
1403    
1404      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
          t_seri, q_seri, u_seri, v_seri, zphi, &  
1405           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1406    
1407      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1408    
1409      !+jld ec_conser      ! conversion Ec -> E thermique
1410      DO k = 1, llm      DO k = 1, llm
1411         DO i = 1, klon         DO i = 1, klon
1412            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1413            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1414                 *(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)
1415            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)
1416            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1417         END DO         END DO
1418      END DO      END DO
     !-jld ec_conser  
     IF (if_ebil >= 1) THEN  
        ztit='after physic'  
        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        !     Comme les tendances de la physique sont ajoute dans la dynamique,  
        !     on devrait avoir que la variation d'entalpie par la dynamique  
        !     est egale a la variation de la physique au pas de temps precedent.  
        !     Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, ztit, ip_ebil &  
             , topsw, toplw, solsw, sollw, sens &  
             , evap, rain_fall, snow_fall, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
   
        d_h_vcol_phy=d_h_vcol  
1419    
1420        IF (if_ebil >= 1) THEN
1421           tit = 'after physic'
1422           CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1423                ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1424           ! Comme les tendances de la physique sont ajoute dans la dynamique,
1425           ! on devrait avoir que la variation d'entalpie par la dynamique
1426           ! est egale a la variation de la physique au pas de temps precedent.
1427           ! Donc la somme de ces 2 variations devrait etre nulle.
1428           call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1429                evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec)
1430           d_h_vcol_phy = d_h_vcol
1431      END IF      END IF
1432    
1433      !   SORTIES      ! SORTIES
1434    
1435      !cc prw = eau precipitable      ! prw = eau precipitable
1436      DO i = 1, klon      DO i = 1, klon
1437         prw(i) = 0.         prw(i) = 0.
1438         DO k = 1, llm         DO k = 1, llm
# Line 1870  contains Line 1444  contains
1444    
1445      DO k = 1, llm      DO k = 1, llm
1446         DO i = 1, klon         DO i = 1, klon
1447            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1448            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1449            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1450            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1451            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1452         ENDDO         ENDDO
1453      ENDDO      ENDDO
1454    
1455      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1456         DO iq = 3, nqmx         DO k = 1, llm
1457            DO  k = 1, llm            DO i = 1, klon
1458               DO  i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys  
              ENDDO  
1459            ENDDO            ENDDO
1460         ENDDO         ENDDO
1461      ENDIF      ENDDO
1462    
1463      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1464      DO k = 1, llm      DO k = 1, llm
# Line 1896  contains Line 1468  contains
1468         ENDDO         ENDDO
1469      ENDDO      ENDDO
1470    
1471      !   Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1472      call write_histins      call write_histins
1473    
1474      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1475      IF (lafin) THEN      IF (lafin) THEN
1476         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1477         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1478              ftsoil, tslab, seaice, fqsurf, qsol, &              fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1479              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1480              solsw, sollwdown, dlw, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1481              radsol, frugs, agesno, &              run_off_lic_0, sig1, w01)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1482      ENDIF      ENDIF
1483    
1484    contains      firstcal = .FALSE.
   
     subroutine write_histday  
   
       use gr_phy_write_3d_m, only: gr_phy_write_3d  
       integer itau_w  ! pas de temps ecriture  
   
       !------------------------------------------------  
   
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
1485    
1486      !****************************    contains
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
1487    
1488      subroutine write_histins      subroutine write_histins
1489    
1490        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1491    
1492          use dimens_m, only: iim, jjm
1493          USE histsync_m, ONLY: histsync
1494          USE histwrite_m, ONLY: histwrite
1495    
1496        real zout        integer i, itau_w ! pas de temps ecriture
1497        integer itau_w  ! pas de temps ecriture        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1498    
1499        !--------------------------------------------------        !--------------------------------------------------
1500    
1501        IF (ok_instan) THEN        IF (ok_instan) THEN
1502           ! Champs 2D:           ! Champs 2D:
1503    
          zsto = pdtphys * ecrit_ins  
          zout = pdtphys * ecrit_ins  
1504           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1505    
1506           i = NINT(zout/zsto)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)  
1507           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1508    
1509           i = NINT(zout/zsto)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)  
1510           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1511    
1512           DO i = 1, klon           DO i = 1, klon
1513              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1514           ENDDO           ENDDO
1515           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1516           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1517    
1518           DO i = 1, klon           DO i = 1, klon
1519              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1520           ENDDO           ENDDO
1521           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1522           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1523    
1524           DO i = 1, klon           DO i = 1, klon
1525              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1526           ENDDO           ENDDO
1527           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1528           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1529    
1530           DO i = 1, klon           DO i = 1, klon
1531              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1532           ENDDO           ENDDO
1533           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1534           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1535    
1536           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1537           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1538           !ccIM           !ccIM
1539           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1540           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1541    
1542           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1543           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1544    
1545           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1546           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1547    
1548           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1549           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1550    
1551           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1552           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1553    
1554           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1555           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1556    
1557           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1558           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1559    
1560           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1561           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1562    
1563           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1564           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1565    
1566           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1567           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1568    
1569           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1570           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1571    
1572           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1573           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1574    
1575           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1576           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1577    
1578           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1579           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1580           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1581           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1582    
1583           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1584           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1585    
1586           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1587           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1588    
1589           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1590           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1591    
1592           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1593           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1594    
1595           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1596           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1597    
1598           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1599              !XXX              !XXX
1600              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1601              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1602              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1603                   zx_tmp_2d)                   zx_tmp_2d)
1604    
1605              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1606              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1607              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1608                   zx_tmp_2d)                   zx_tmp_2d)
1609    
1610              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1611              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1612              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1613                   zx_tmp_2d)                   zx_tmp_2d)
1614    
1615              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1616              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1617              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1618                   zx_tmp_2d)                   zx_tmp_2d)
1619    
1620              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1621              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1622              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1623                   zx_tmp_2d)                   zx_tmp_2d)
1624    
1625              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1626              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1627              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1628                   zx_tmp_2d)                   zx_tmp_2d)
1629    
1630              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1631              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1632              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1633                   zx_tmp_2d)                   zx_tmp_2d)
1634    
1635              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1636              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1637              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1638                   zx_tmp_2d)                   zx_tmp_2d)
1639    
1640              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1641              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1642              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1643                   zx_tmp_2d)                   zx_tmp_2d)
1644    
1645           END DO           END DO
1646           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1647           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1648           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1649           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1650    
1651           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1652           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1653    
          !IM cf. AM 081204 BEG  
   
1654           !HBTM2           !HBTM2
1655    
1656           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1657           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1658    
1659           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1660           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1661    
1662           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1663           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1664    
1665           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
1666           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1667    
1668           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
1669           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1670    
1671           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
1672           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1673    
1674           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
1675           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1676    
1677           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
1678           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1679    
1680           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
1681           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1682    
1683           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
1684           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1685    
          !IM cf. AM 081204 END  
   
1686           ! Champs 3D:           ! Champs 3D:
1687    
1688           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
1689           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1690    
1691           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
1692           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1693    
1694           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
1695           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1696    
1697           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
1698           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1699    
1700           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
1701           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1702    
1703           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
1704           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1705    
1706           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1707           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1708    
1709           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1710        ENDIF        ENDIF
1711    
1712      end subroutine write_histins      end subroutine write_histins
1713    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09  
   
       integer itau_w  ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1714    END SUBROUTINE physiq    END SUBROUTINE physiq
1715    
1716  end module physiq_m  end module physiq_m
Legend:
Removed from v.34  
changed lines
  Added in v.151
  ViewVC Help
Powered by ViewVC 1.1.21