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

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

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

trunk/libf/phylmd/physiq.f90 revision 34 by guez, Wed Jun 2 11:01:12 2010 UTC trunk/phylmd/physiq.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 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, rdayvrai, 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, d_ps, dudyn, PVteta)
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
   
     ! Objet: Moniteur general de la physique du modele  
     !AA      Modifications quant aux traceurs :  
     !AA                  -  uniformisation des parametrisations ds phytrac  
     !AA                  -  stockage des moyennes des champs necessaires  
     !AA                     en mode traceur off-line  
   
     use abort_gcm_m, only: abort_gcm  
     USE calendar, only: ymds2ju  
     use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &  
          cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &  
          ok_kzmin  
     use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &  
          cycle_diurne, new_oliq, soil_model  
     use comgeomphy  
     use conf_gcm_m, only: raz_date, offline  
     use conf_phys_m, only: conf_phys  
     use ctherm  
     use dimens_m, only: jjm, iim, llm, nqmx  
     use dimphy, only: klon, nbtr  
     use dimsoil, only: nsoilmx  
     use hgardfou_m, only: hgardfou  
     USE histcom, only: histsync  
     USE histwrite_m, only: histwrite  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use ini_histhf_m, only: ini_histhf  
     use ini_histday_m, only: ini_histday  
     use ini_histins_m, only: ini_histins  
     use iniprint, only: prt_level  
     use oasis_m  
     use orbite_m, only: orbite, zenang  
     use ozonecm_m, only: ozonecm  
     use phyetat0_m, only: phyetat0, rlat, rlon  
     use phyredem_m, only: phyredem  
     use phystokenc_m, only: phystokenc  
     use phytrac_m, only: phytrac  
     use qcheck_m, only: qcheck  
     use radepsi  
     use radopt  
     use temps, only: itau_phy, day_ref, annee_ref  
     use yoethf  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
14    
15      ! Declaration des constantes et des fonctions thermodynamiques :      ! This is the main procedure for the "physics" part of the program.
16      use fcttre, only: thermcep, foeew, qsats, qsatl  
17        use aaam_bud_m, only: aaam_bud
18        USE abort_gcm_m, ONLY: abort_gcm
19        use aeropt_m, only: aeropt
20        use ajsec_m, only: ajsec
21        USE calendar, ONLY: ymds2ju
22        use calltherm_m, only: calltherm
23        USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
24             ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
25        USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
26             ok_orodr, ok_orolf, soil_model
27        USE clmain_m, ONLY: clmain
28        use clouds_gno_m, only: clouds_gno
29        USE comgeomphy, ONLY: airephy, cuphy, cvphy
30        USE concvl_m, ONLY: concvl
31        USE conf_gcm_m, ONLY: offline, raz_date
32        USE conf_phys_m, ONLY: conf_phys
33        use conflx_m, only: conflx
34        USE ctherm, ONLY: iflag_thermals, nsplit_thermals
35        use diagcld2_m, only: diagcld2
36        use diagetpq_m, only: diagetpq
37        use diagphy_m, only: diagphy
38        USE dimens_m, ONLY: iim, jjm, llm, nqmx
39        USE dimphy, ONLY: klon, nbtr
40        USE dimsoil, ONLY: nsoilmx
41        use drag_noro_m, only: drag_noro
42        USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43        use fisrtilp_m, only: fisrtilp
44        USE hgardfou_m, ONLY: hgardfou
45        USE histsync_m, ONLY: histsync
46        USE histwrite_m, ONLY: histwrite
47        USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
48             nbsrf
49        USE ini_histhf_m, ONLY: ini_histhf
50        USE ini_histday_m, ONLY: ini_histday
51        USE ini_histins_m, ONLY: ini_histins
52        use newmicro_m, only: newmicro
53        USE oasis_m, ONLY: ok_oasis
54        USE orbite_m, ONLY: orbite, zenang
55        USE ozonecm_m, ONLY: ozonecm
56        USE phyetat0_m, ONLY: phyetat0, rlat, rlon
57        USE phyredem_m, ONLY: phyredem
58        USE phystokenc_m, ONLY: phystokenc
59        USE phytrac_m, ONLY: phytrac
60        USE qcheck_m, ONLY: qcheck
61        use radlwsw_m, only: radlwsw
62        use readsulfate_m, only: readsulfate
63        use sugwd_m, only: sugwd
64        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65        USE temps, ONLY: annee_ref, day_ref, itau_phy
66        use unit_nml_m, only: unit_nml
67        USE yoethf_m, ONLY: r2es, rvtmp2
68    
69      ! Variables argument:      ! Arguments:
70    
71      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
72      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
73    
74      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journée en fraction de jour
75      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
76      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
77    
78      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
79      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
80    
81      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
82      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
83    
84      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
85      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
86    
87      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
88    
89      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: u(klon, llm)
90      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      ! vitesse dans la direction X (de O a E) en m/s
91      REAL t(klon, llm)  ! input temperature (K)  
92        REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
93        REAL, intent(in):: t(klon, llm) ! input temperature (K)
94    
95      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
96      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
97    
98      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
99      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
100      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
101      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
102      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
103      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon) ! output tendance physique de la pression au sol
104    
105        LOGICAL:: firstcal = .true.
106    
107      INTEGER nbteta      INTEGER nbteta
108      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
109    
110      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
111      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
112    
     LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
113      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
114      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
115    
116      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
117      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
118      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
119      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
120        ! Ajouter artificiellement les stratus
121    
122      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
123      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
124      logical rnpb      logical rnpb
125      parameter(rnpb=.true.)      parameter(rnpb = .true.)
126    
127      character(len=6), save:: ocean      character(len = 6):: ocean = 'force '
128      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
129    
130      logical ok_ocean      ! "slab" ocean
131      SAVE ok_ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
132        REAL, save:: seaice(klon) ! glace de mer (kg/m2)
133      !IM "slab" ocean      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
134      REAL tslab(klon)    !Temperature du slab-ocean      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     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  
135    
136      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
137      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
138    
139      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
140      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
141        ! fichiers histday, histmth et histins
142    
143      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
144      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
145    
146      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
147      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
148      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
149      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
     save q2  
150    
151      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
152      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
153      INTEGER iliq          ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
154      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
155    
156      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
157      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
158    
159      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
160      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)
161    
162      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
163    
164      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
165    
166      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
167      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
168      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
169      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
170    
171      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
172    
173      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
174      PARAMETER(klevp1=llm+1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
175      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
176    
177      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
178      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
179      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
180    
181      !IM Amip2      !IM Amip2
182      ! variables a une pression donnee      ! variables a une pression donnee
183    
184      integer nlevSTD      integer nlevSTD
185      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
186      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
187      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
188           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
189           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
190      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
191      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
192           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
193           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
194    
195      ! prw: precipitable water      ! prw: precipitable water
196      real prw(klon)      real prw(klon)
# Line 210  contains Line 201  contains
201      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
202    
203      INTEGER kmax, lmax      INTEGER kmax, lmax
204      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
205      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
206      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
207    
208      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
209      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./
210      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
211    
212      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 223  contains Line 214  contains
214      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
215    
216      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
217      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
218    
219      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
220      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
221      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
222    
223      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
224      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', &
225           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
226           '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 268  contains Line 259  contains
259      ! "physiq".)      ! "physiq".)
260    
261      REAL radsol(klon)      REAL radsol(klon)
262      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
263    
264      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
265    
266      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
267    
268      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
269      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
270    
271      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap                 ! evaporation  
272      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
273      SAVE fluxlat      SAVE fluxlat
274    
275      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
276      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
277    
278      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
279    
280      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
281      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
282    
283      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
284      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
285      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
286      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
287    
288      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
289      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 312  contains Line 300  contains
300      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
301    
302      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
303      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
304    
305      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
306      SAVE run_off_lic_0      SAVE run_off_lic_0
307      !KE43      !KE43
308      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
309    
310      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
311      SAVE bas      SAVE bas
312      SAVE top      SAVE top
313    
314      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
315      SAVE Ma      SAVE Ma
316      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
317      SAVE qcondc      SAVE qcondc
318      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
319      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd       ! sb  
320    
321      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
322    
# Line 340  contains Line 325  contains
325      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
326      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
327    
328      !AA  Pour phytrac      ! Pour phytrac :
329      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
330      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
331      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
332      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
333      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
334      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
335      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
336      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
337    
338      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 359  contains Line 344  contains
344      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
345      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
346    
347      !AA      REAL, save:: rain_fall(klon) ! pluie
348      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
349      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
350      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
351    
352      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
353      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
354      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
355      SAVE dlw      SAVE dlw
356      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
357      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 387  contains Line 370  contains
370      INTEGER julien      INTEGER julien
371    
372      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
373      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
374      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
375    
     SAVE pctsrf                 ! sous-fraction du sol  
376      REAL albsol(klon)      REAL albsol(klon)
377      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
378      REAL albsollw(klon)      REAL albsollw(klon)
379      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
380    
381      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
382    
383      ! Declaration des procedures appelees      ! Declaration des procedures appelees
384    
385      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec     ! ajustement sec  
     EXTERNAL clmain    ! couche limite  
386      !KE43      !KE43
387      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
388      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL nuage ! calculer les proprietes radiatives
389      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
390    
391      ! Variables locales      ! Variables locales
392    
393      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
394      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
395    
396      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
397      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
398      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
399      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
400      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
401      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
402      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
403    
404      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
405      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
406      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
407      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
408    
409      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
410      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
411      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
412      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
413    
414      REAL heat(klon, llm)    ! chauffage solaire      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que
415      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! les variables soient rémanentes.
416      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
417      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
418      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
419      real sollwdown(klon)    ! downward LW flux at surface      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
420      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
421        REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface
422        real, save:: sollwdown(klon) ! downward LW flux at surface
423        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
424      REAL albpla(klon)      REAL albpla(klon)
425      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
426      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
427      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla
428      !                      sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
429    
430      INTEGER itaprad      INTEGER itaprad
431      SAVE itaprad      SAVE itaprad
432    
433      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
434      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
435    
436      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
437      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 465  contains Line 441  contains
441      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
442      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
443      real zlongi      real zlongi
   
444      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
445      REAL za, zb      REAL za, zb
446      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
447      real zqsat(klon, llm)      real zqsat(klon, llm)
448      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
449      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup=234.0)  
   
450      REAL zphi(klon, llm)      REAL zphi(klon, llm)
451    
452      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
453    
454      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
455      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
456      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
457      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
458      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
459      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
460      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
461      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
462      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
463      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
464      ! Grdeurs de sorties      ! Grdeurs de sorties
465      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
466      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
467      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
468      REAL s_trmb3(klon)      REAL s_trmb3(klon)
469    
470      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
471    
472      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
473      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
474      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
475      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
476      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
477      SAVE cape      SAVE cape
478    
479      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
480      SAVE pbase      SAVE pbase
481      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
482      SAVE bbase      SAVE bbase
483      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
484      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
485      ! -- convect43:      ! -- convect43:
     INTEGER ntra              ! nb traceurs pour convect4.3  
486      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
487      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
488    
489      ! Variables du changement      ! Variables du changement
490    
491      ! con: convection      ! con: convection
492      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
493      ! ajs: ajustement sec      ! ajs: ajustement sec
494      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
495      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
496      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
497      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
498      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 500  contains
500      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
501      REAL rneb(klon, llm)      REAL rneb(klon, llm)
502    
503      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
504      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
505      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
506      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
507      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
508      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)  
509    
510      SAVE ibas_con, itop_con      INTEGER, save:: ibas_con(klon), itop_con(klon)
511    
512      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
513      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 553  contains Line 521  contains
521      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
522      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
523    
524      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
525      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
526      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
527    
528      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
529      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
530      real, save:: facttemps      real:: facttemps = 1.e-4
531      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
532      real facteur      real facteur
533    
534      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
535      logical ptconv(klon, llm)      logical ptconv(klon, llm)
536    
537      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en série :
538    
539      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
540      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 585  contains Line 550  contains
550      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
551      REAL aam, torsfc      REAL aam, torsfc
552    
553      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
554    
555      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
556      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
557    
558      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 599  contains Line 564  contains
564    
565      REAL zsto      REAL zsto
566    
     character(len=20) modname  
     character(len=80) abort_message  
567      logical ok_sync      logical ok_sync
568      real date0      real date0
569    
570      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
571      REAL ztsol(klon)      REAL ztsol(klon)
572      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
573      REAL      d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
574      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
575      SAVE      d_h_vcol_phy      REAL zero_v(klon)
576      REAL      zero_v(klon)      CHARACTER(LEN = 15) tit
577      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
578      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
579      SAVE      ip_ebil  
580      DATA      ip_ebil/0/      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
     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  
581      REAL ZRCPD      REAL ZRCPD
582      !-jld ec_conser  
583      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
584      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
585      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
586      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
587      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille  
588      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      ! Aerosol effects:
589      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]  
590        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
591      REAL sulfate_pi(klon, llm)  
592      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      REAL, save:: sulfate_pi(klon, llm)
593      SAVE sulfate_pi      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
594    
595      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
596      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
597    
598      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
599      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
600    
601      ! Aerosol optical properties      ! Aerosol optical properties
602      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
603      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
604    
605      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
606      ! ok_ade=T -ADE=topswad-topsw      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
607    
608      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  
609    
610      REAL aerindex(klon)       ! POLDER aerosol index      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
611        LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
612    
613      ! Parameters      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
614      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
615      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      ! B). They link cloud droplet number concentration to aerosol mass
616        ! concentration.
617    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
618      SAVE u10m      SAVE u10m
619      SAVE v10m      SAVE v10m
620      SAVE t2m      SAVE t2m
621      SAVE q2m      SAVE q2m
622      SAVE ffonte      SAVE ffonte
623      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
624      SAVE rain_con      SAVE rain_con
625      SAVE snow_con      SAVE snow_con
626      SAVE topswai      SAVE topswai
# Line 674  contains Line 629  contains
629      SAVE solswad      SAVE solswad
630      SAVE d_u_con      SAVE d_u_con
631      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  
632    
633      real zmasse(klon, llm)      real zmasse(klon, llm)
634      ! (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)
635    
636      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
637    
638        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
639             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
640             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
641             nsplit_thermals
642    
643      !----------------------------------------------------------------      !----------------------------------------------------------------
644    
645      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
646      IF (if_ebil >= 1) THEN      ok_sync = .TRUE.
647         DO i=1, klon      IF (nqmx < 2) CALL abort_gcm('physiq', &
648            zero_v(i)=0.           'eaux vapeur et liquide sont indispensables', 1)
        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  
649    
650      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
651         !  initialiser         ! initialiser
652         u10m=0.         u10m = 0.
653         v10m=0.         v10m = 0.
654         t2m=0.         t2m = 0.
655         q2m=0.         q2m = 0.
656         ffonte=0.         ffonte = 0.
657         fqcalving=0.         fqcalving = 0.
658         piz_ae(:, :, :)=0.         piz_ae = 0.
659         tau_ae(:, :, :)=0.         tau_ae = 0.
660         cg_ae(:, :, :)=0.         cg_ae = 0.
661         rain_con(:)=0.         rain_con(:) = 0.
662         snow_con(:)=0.         snow_con(:) = 0.
663         bl95_b0=0.         topswai(:) = 0.
664         bl95_b1=0.         topswad(:) = 0.
665         topswai(:)=0.         solswai(:) = 0.
666         topswad(:)=0.         solswad(:) = 0.
667         solswai(:)=0.  
668         solswad(:)=0.         d_u_con = 0.
669           d_v_con = 0.
670         d_u_con = 0.0         rnebcon0 = 0.
671         d_v_con = 0.0         clwcon0 = 0.
672         rnebcon0 = 0.0         rnebcon = 0.
673         clwcon0 = 0.0         clwcon = 0.
674         rnebcon = 0.0  
675         clwcon = 0.0         pblh =0. ! Hauteur de couche limite
676           plcl =0. ! Niveau de condensation de la CLA
677         pblh   =0.        ! Hauteur de couche limite         capCL =0. ! CAPE de couche limite
678         plcl   =0.        ! Niveau de condensation de la CLA         oliqCL =0. ! eau_liqu integree de couche limite
679         capCL  =0.        ! CAPE de couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
680         oliqCL =0.        ! eau_liqu integree de couche limite         pblt =0. ! T a la Hauteur de couche limite
681         cteiCL =0.        ! cloud top instab. crit. couche limite         therm =0.
682         pblt   =0.        ! T a la Hauteur de couche limite         trmb1 =0. ! deep_cape
683         therm  =0.         trmb2 =0. ! inhibition
684         trmb1  =0.        ! deep_cape         trmb3 =0. ! Point Omega
685         trmb2  =0.        ! inhibition  
686         trmb3  =0.        ! Point Omega         IF (if_ebil >= 1) d_h_vcol_phy = 0.
687    
688         IF (if_ebil >= 1) d_h_vcol_phy=0.         iflag_thermals = 0
689           nsplit_thermals = 1
690         ! appel a la lecture du run.def physique         print *, "Enter namelist 'physiq_nml'."
691           read(unit=*, nml=physiq_nml)
692         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         write(unit_nml, nml=physiq_nml)
693              ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
694              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &         call conf_phys
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
695    
696         ! Initialiser les compteurs:         ! Initialiser les compteurs:
697    
# Line 761  contains Line 699  contains
699         itap = 0         itap = 0
700         itaprad = 0         itaprad = 0
701         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
702              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
703              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
704              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
705              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
706    
707         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
708         q2(:, :, :)=1.e-8         q2 = 1e-8
709    
710         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
711    
712         ! on remet le calendrier a zero         ! on remet le calendrier a zero
713         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
714    
715         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
716           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
717                ok_instan, ok_region)
718    
719         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
720            ok_ocean=.TRUE.            print *, "Au minimum 4 appels par jour si cycle diurne"
721         ENDIF            call abort_gcm('physiq', &
722                   "Nombre d'appels au rayonnement insuffisant", 1)
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             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)  
723         ENDIF         ENDIF
        print *,"Clef pour la convection, iflag_con=", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
724    
725         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
726         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
727              ibas_con = 1
728            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  
   
729         ENDIF         ENDIF
730    
731         IF (ok_orodr) THEN         IF (ok_orodr) THEN
732            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
733            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(paprs, play)
734         else         else
735            rugoro = 0.            rugoro = 0.
736         ENDIF         ENDIF
737    
738         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
739         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
740    
741         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
742         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
743         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
744         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
745         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
746    
747         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
748    
749         npas = 0         npas = 0
750         nexca = 0         nexca = 0
751    
752         print *,'AVANT HIST IFLAG_CON=', iflag_con         ! Initialisation des sorties
753    
754         !   Initialisation des sorties         call ini_histhf(dtphys, nid_hf, nid_hf3d)
755           call ini_histday(dtphys, ok_journe, nid_day, nqmx)
756         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histins(dtphys, ok_instan, nid_ins)
        call ini_histday(pdtphys, ok_journe, nid_day, nqmx)  
        call ini_histins(pdtphys, ok_instan, nid_ins)  
757         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
758         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
759         WRITE(*, *) 'physiq date0 : ', date0         print *, 'physiq date0: ', date0
760      ENDIF test_firstcal      ENDIF test_firstcal
761    
762      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
763    
764      DO i = 1, klon      DO i = 1, klon
765         d_ps(i) = 0.0         d_ps(i) = 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  
766      ENDDO      ENDDO
767      DO iq = 1, nqmx      DO iq = 1, nqmx
768         DO k = 1, llm         DO k = 1, llm
769            DO i = 1, klon            DO i = 1, klon
770               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
771            ENDDO            ENDDO
772         ENDDO         ENDDO
773      ENDDO      ENDDO
774      da=0.      da = 0.
775      mp=0.      mp = 0.
776      phi(:, :, :)=0.      phi = 0.
777    
778      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrées de u, v, h, et q :
779    
780      DO k = 1, llm      DO k = 1, llm
781         DO i = 1, klon         DO i = 1, klon
782            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
783            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
784            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
785            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
786            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
787            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
788         ENDDO         ENDDO
# Line 893  contains Line 803  contains
803      ENDDO      ENDDO
804    
805      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
806         ztit='after dynamic'         tit = 'after dynamics'
807         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
808              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
809              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
810         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
811         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
812         !     est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
813         !     Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
814         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
815              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
816              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
817              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
818      END IF      END IF
819    
820      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
821      IF (ancien_ok) THEN      IF (ancien_ok) THEN
822         DO k = 1, llm         DO k = 1, llm
823            DO i = 1, klon            DO i = 1, klon
824               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
825               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
826            ENDDO            ENDDO
827         ENDDO         ENDDO
828      ELSE      ELSE
829         DO k = 1, llm         DO k = 1, llm
830            DO i = 1, klon            DO i = 1, klon
831               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
832               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
833            ENDDO            ENDDO
834         ENDDO         ENDDO
835         ancien_ok = .TRUE.         ancien_ok = .TRUE.
836      ENDIF      ENDIF
837    
838      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
839      DO k = 1, llm      DO k = 1, llm
840         DO i = 1, klon         DO i = 1, klon
841            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
842         ENDDO         ENDDO
843      ENDDO      ENDDO
844    
845      ! Verifier les temperatures      ! Check temperatures:
   
846      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
847    
848      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
849      itap = itap + 1      itap = itap + 1
850      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
851      if (julien == 0) julien = 360      if (julien == 0) julien = 360
852    
853      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
854    
855      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
   
     if (nqmx >= 5) then  
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
856    
857      ! Re-evaporer l'eau liquide nuageuse      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
858        wo = ozonecm(REAL(julien), paprs)
859    
860      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
861        DO k = 1, llm
862         DO i = 1, klon         DO i = 1, klon
863            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
864            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
865            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  
866            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
867         ENDDO         ENDDO
868      ENDDO      ENDDO
869        ql_seri = 0.
870    
871      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
872         ztit='after reevap'         tit = 'after reevap'
873         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
874              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
875              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
876         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
877              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
878              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
879    
880      END IF      END IF
881    
882      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
883    
884      DO i = 1, klon      DO i = 1, klon
885         zxrugs(i) = 0.0         zxrugs(i) = 0.
886      ENDDO      ENDDO
887      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
888         DO i = 1, klon         DO i = 1, klon
# Line 1005  contains Line 899  contains
899    
900      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
901      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
902         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
903         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
904      ELSE      ELSE
905         rmu0 = -999.999         rmu0 = -999.999
906      ENDIF      ENDIF
907    
908      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
909      albsol(:)=0.      albsol(:) = 0.
910      albsollw(:)=0.      albsollw(:) = 0.
911      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
912         DO i = 1, klon         DO i = 1, klon
913            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1021  contains Line 915  contains
915         ENDDO         ENDDO
916      ENDDO      ENDDO
917    
918      !     Repartition sous maille des flux LW et SW      ! Répartition sous maille des flux longwave et shortwave
919      ! Repartition du longwave par sous-surface linearisee      ! Répartition du longwave par sous-surface linéarisée
920    
921      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
922         DO i = 1, klon         DO i = 1, klon
923            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
924                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
925            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
926         ENDDO         ENDDO
927      ENDDO      ENDDO
928    
929      fder = dlw      fder = dlw
930    
931      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
932           t_seri, q_seri, u_seri, v_seri, &  
933           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
934           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
935           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
936           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
937           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
938           fluxlat, rain_fall, snow_fall, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
939           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
940           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
941           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
942           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
943           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
944           q2, dsens, devap, &      ! Incrémentation des flux
945           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
946           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
947           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
948           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
949           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
950      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
951         DO k = 1, llm         DO k = 1, llm
952            DO i = 1, klon            DO i = 1, klon
953               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
954                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
955               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
956                    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)  
957            END DO            END DO
958         END DO         END DO
959      END DO      END DO
960      DO i = 1, klon      DO i = 1, klon
961         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
962         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
963         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
964      ENDDO      ENDDO
965    
# Line 1090  contains Line 973  contains
973      ENDDO      ENDDO
974    
975      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
976         ztit='after clmain'         tit = 'after clmain'
977         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
978              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
979              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
980         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
981              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
982              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
983      END IF      END IF
984    
985      ! Incrementer la temperature du sol      ! Update surface temperature:
986    
987      DO i = 1, klon      DO i = 1, klon
988         zxtsol(i) = 0.0         zxtsol(i) = 0.
989         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
990    
991         zt2m(i) = 0.0         zt2m(i) = 0.
992         zq2m(i) = 0.0         zq2m(i) = 0.
993         zu10m(i) = 0.0         zu10m(i) = 0.
994         zv10m(i) = 0.0         zv10m(i) = 0.
995         zxffonte(i) = 0.0         zxffonte(i) = 0.
996         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
997    
998         s_pblh(i) = 0.0         s_pblh(i) = 0.
999         s_lcl(i) = 0.0         s_lcl(i) = 0.
1000         s_capCL(i) = 0.0         s_capCL(i) = 0.
1001         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
1002         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
1003         s_pblT(i) = 0.0         s_pblT(i) = 0.
1004         s_therm(i) = 0.0         s_therm(i) = 0.
1005         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
1006         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
1007         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
1008    
1009         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1010              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1011              THEN              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i,  &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
1012      ENDDO      ENDDO
1013      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1014         DO i = 1, klon         DO i = 1, klon
# Line 1143  contains Line 1021  contains
1021            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1022            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1023            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1024            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1025                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1026            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1027            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 1162  contains Line 1040  contains
1040    
1041      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1042         DO i = 1, klon         DO i = 1, klon
1043            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1044    
1045            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1046            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1047            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1048            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1049            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1050            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1051                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1052            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1053            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1054            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1055            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1056            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1057            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1058            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1059            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1060            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1061            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1062         ENDDO         ENDDO
1063      ENDDO      ENDDO
1064    
1065      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1066    
1067      DO i = 1, klon      DO i = 1, klon
1068         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1069      ENDDO      ENDDO
1070    
1071      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1072    
1073      DO k = 1, llm      DO k = 1, llm
1074         DO i = 1, klon         DO i = 1, klon
1075            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1076                 + d_q_vdf(i, k)/pdtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k)  &  
                + d_t_vdf(i, k)/pdtphys  
1077         ENDDO         ENDDO
1078      ENDDO      ENDDO
1079    
1080      IF (check) THEN      IF (check) THEN
1081         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1082         print *, "avantcon=", za         print *, "avantcon = ", za
1083      ENDIF      ENDIF
1084      zx_ajustq = .FALSE.  
1085      IF (iflag_con == 2) zx_ajustq=.TRUE.      if (iflag_con == 2) then
1086      IF (zx_ajustq) THEN         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1087         DO i = 1, klon         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1088            z_avant(i) = 0.0              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1089         ENDDO              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1090         DO k = 1, llm              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1091            DO i = 1, klon              kdtop, pmflxr, pmflxs)
              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)  
1092         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1093         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1094         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1095            ibas_con(i) = llm+1 - kcbot(i)         itop_con = llm + 1 - kctop
1096            itop_con(i) = llm+1 - kctop(i)      else
1097         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  
1098    
1099         IF (.NOT. ok_gust) THEN         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1100            do i = 1, klon              v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1101               wd(i)=0.0              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1102            enddo              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1103         ENDIF              pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1104                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1105           ! (number of tracers for the convection scheme of Kerry Emanuel:
1106           ! la partie traceurs est faite dans phytrac
1107           ! on met ntra = 1 pour limiter les appels mais on peut
1108           ! supprimer les calculs / ftra.)
1109    
1110           clwcon0 = qcondc
1111           mfu = upwd + dnwd
1112           IF (.NOT. ok_gust) wd = 0.
1113    
1114         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1115    
1116         DO k = 1, llm         DO k = 1, llm
1117            DO i = 1, klon            DO i = 1, klon
1118               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1119               IF (thermcep) THEN               IF (thermcep) THEN
1120                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1121                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1122                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1123                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1124                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1125               ELSE               ELSE
1126                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1127                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1128                  ELSE                  ELSE
1129                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1130                  ENDIF                  ENDIF
1131               ENDIF               ENDIF
1132               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1133            ENDDO            ENDDO
1134         ENDDO         ENDDO
1135    
1136         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1137         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1138         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1139              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1140      ELSE  
1141         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1142         stop 1         pen_u = 0.
1143      ENDIF         pen_d = 0.
1144           pde_d = 0.
1145           pde_u = 0.
1146        END if
1147    
1148      DO k = 1, llm      DO k = 1, llm
1149         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 1155  contains
1155      ENDDO      ENDDO
1156    
1157      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1158         ztit='after convect'         tit = 'after convect'
1159         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1160              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1161              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1162         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1163              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1164              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1165      END IF      END IF
1166    
1167      IF (check) THEN      IF (check) THEN
1168         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1169         print *,"aprescon=", za         print *, "aprescon = ", za
1170         zx_t = 0.0         zx_t = 0.
1171         za = 0.0         za = 0.
1172         DO i = 1, klon         DO i = 1, klon
1173            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1174            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1175                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1176         ENDDO         ENDDO
1177         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1178         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1179      ENDIF      ENDIF
1180      IF (zx_ajustq) THEN  
1181         DO i = 1, klon      IF (iflag_con == 2) THEN
1182            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1183         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  
1184         DO k = 1, llm         DO k = 1, llm
1185            DO i = 1, klon            DO i = 1, klon
1186               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  
1187                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1188               ENDIF               ENDIF
1189            ENDDO            ENDDO
1190         ENDDO         ENDDO
1191      ENDIF      ENDIF
     zx_ajustq=.FALSE.  
1192    
1193      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1194    
1195      d_t_ajs=0.      d_t_ajs = 0.
1196      d_u_ajs=0.      d_u_ajs = 0.
1197      d_v_ajs=0.      d_v_ajs = 0.
1198      d_q_ajs=0.      d_q_ajs = 0.
1199      fm_therm=0.      fm_therm = 0.
1200      entr_therm=0.      entr_therm = 0.
1201    
1202      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1203           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1204           , 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)  
1205         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1206         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1207      else      else
1208         !  Thermiques         ! Thermiques
1209         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1210              , 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)  
1211      endif      endif
1212    
1213      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1214         ztit='after dry_adjust'         tit = 'after dry_adjust'
1215         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1216              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1217              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1218      END IF      END IF
1219    
1220      !  Caclul des ratqs      ! Caclul des ratqs
1221    
1222      !   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q
1223      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1224      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1225         do k=1, llm         do k = 1, llm
1226            do i=1, klon            do i = 1, klon
1227               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1228                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1229                       +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)
1230               else               else
1231                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1232               endif               endif
1233            enddo            enddo
1234         enddo         enddo
1235      endif      endif
1236    
1237      !   ratqs stables      ! ratqs stables
1238      do k=1, llm      do k = 1, llm
1239         do i=1, klon         do i = 1, klon
1240            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1241                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1242         enddo         enddo
1243      enddo      enddo
1244    
1245      !  ratqs final      ! ratqs final
1246      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1247         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1248         !   ratqs final         ! ratqs final
1249         !   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
1250         !   relaxation des ratqs         ! relaxation des ratqs
1251         facteur=exp(-pdtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
1252         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs, ratqsc)
        ratqs=max(ratqs, ratqsc)  
1253      else      else
1254         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1255         ratqs=ratqss         ratqs = ratqss
1256      endif      endif
1257    
1258      ! Appeler le processus de condensation a grande echelle      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1259      ! et le processus de precipitation           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1260      CALL fisrtilp(pdtphys, paprs, pplay, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1261           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)  
1262    
1263      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1264      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1465  contains Line 1273  contains
1273      ENDDO      ENDDO
1274      IF (check) THEN      IF (check) THEN
1275         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1276         print *,"apresilp=", za         print *, "apresilp = ", za
1277         zx_t = 0.0         zx_t = 0.
1278         za = 0.0         za = 0.
1279         DO i = 1, klon         DO i = 1, klon
1280            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1281            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1282                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1283         ENDDO         ENDDO
1284         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1285         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1286      ENDIF      ENDIF
1287    
1288      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1289         ztit='after fisrt'         tit = 'after fisrt'
1290         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1291              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1292              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1293         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1294              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1295              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1296      END IF      END IF
1297    
1298      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1299    
1300      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1301    
1302      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1303         snow_tiedtke=0.         ! seulement pour Tiedtke
1304           snow_tiedtke = 0.
1305         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1306            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1307         else         else
1308            rain_tiedtke=0.            rain_tiedtke = 0.
1309            do k=1, llm            do k = 1, llm
1310               do i=1, klon               do i = 1, klon
1311                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1312                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1313                          *zmasse(i, k)                          *zmasse(i, k)
1314                  endif                  endif
1315               enddo               enddo
# Line 1510  contains Line 1317  contains
1317         endif         endif
1318    
1319         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1320         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1321              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1322         DO k = 1, llm         DO k = 1, llm
1323            DO i = 1, klon            DO i = 1, klon
1324               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1325                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1326                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1327               ENDIF               ENDIF
1328            ENDDO            ENDDO
1329         ENDDO         ENDDO
   
1330      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1331         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1332         ! 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écédent diminué
1333         ! facttemps         ! d'un facteur facttemps.
1334         facteur = pdtphys *facttemps         facteur = dtphys * facttemps
1335         do k=1, llm         do k = 1, llm
1336            do i=1, klon            do i = 1, klon
1337               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1338               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1339                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1340                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1341                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1342               endif               endif
1343            enddo            enddo
1344         enddo         enddo
1345    
1346         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1347         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1348         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1349      ENDIF      ENDIF
1350    
1351      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1352    
1353      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1354         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1355         DO k = 1, llm         DO k = 1, llm
1356            DO i = 1, klon            DO i = 1, klon
1357               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1358                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1359                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1360               ENDIF               ENDIF
# Line 1559  contains Line 1363  contains
1363      ENDIF      ENDIF
1364    
1365      ! Precipitation totale      ! Precipitation totale
   
1366      DO i = 1, klon      DO i = 1, klon
1367         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1368         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1369      ENDDO      ENDDO
1370    
1371      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1372         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1373         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, 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  
1374    
1375        ! Humidité relative pour diagnostic :
1376      DO k = 1, llm      DO k = 1, llm
1377         DO i = 1, klon         DO i = 1, klon
1378            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1379            IF (thermcep) THEN            IF (thermcep) THEN
1380               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1381               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1382               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1383               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1384               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1385            ELSE            ELSE
1386               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1387                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1388               ELSE               ELSE
1389                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1390               ENDIF               ENDIF
1391            ENDIF            ENDIF
1392            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1393            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1394         ENDDO         ENDDO
1395      ENDDO      ENDDO
1396      !jq - introduce the aerosol direct and first indirect radiative forcings  
1397      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1398      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1399         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1400         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1401         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1402    
1403         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1404         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1405      ELSE      ELSE
1406         tau_ae(:, :, :)=0.0         tau_ae = 0.
1407         piz_ae(:, :, :)=0.0         piz_ae = 0.
1408         cg_ae(:, :, :)=0.0         cg_ae = 0.
1409      ENDIF      ENDIF
1410    
1411      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! parametres pour diagnostiques:  
   
1412      if (ok_newmicro) then      if (ok_newmicro) then
1413         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1414              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1415              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)  
1416      else      else
1417         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1418              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1419              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1420      endif      endif
1421    
1422      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1423      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1424         DO i = 1, klon         DO i = 1, klon
1425            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1646  contains Line 1431  contains
1431                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1432                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1433         ENDDO         ENDDO
1434         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1435         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1436              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1437              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1438              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1439              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1440              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)  
1441         itaprad = 0         itaprad = 0
1442      ENDIF      ENDIF
1443      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1670  contains Line 1446  contains
1446    
1447      DO k = 1, llm      DO k = 1, llm
1448         DO i = 1, klon         DO i = 1, klon
1449            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.  
1450         ENDDO         ENDDO
1451      ENDDO      ENDDO
1452    
1453      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1454         ztit='after rad'         tit = 'after rad'
1455         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1456              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1457              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1458         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1459              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1460              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1461      END IF      END IF
1462    
1463      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1464      DO i = 1, klon      DO i = 1, klon
1465         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1466         zxsnow(i) = 0.0         zxsnow(i) = 0.
1467      ENDDO      ENDDO
1468      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1469         DO i = 1, klon         DO i = 1, klon
# Line 1700  contains Line 1472  contains
1472         ENDDO         ENDDO
1473      ENDDO      ENDDO
1474    
1475      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1476    
1477      DO i = 1, klon      DO i = 1, klon
1478         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1479      ENDDO      ENDDO
1480    
1481      !mod deb lott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1482    
1483      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1484         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1485         igwd=0         igwd = 0
1486         DO i=1, klon         DO i = 1, klon
1487            itest(i)=0            itest(i) = 0
1488            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
1489               itest(i)=1               itest(i) = 1
1490               igwd=igwd+1               igwd = igwd + 1
1491               idx(igwd)=i               idx(igwd) = i
1492            ENDIF            ENDIF
1493         ENDDO         ENDDO
1494    
1495         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1496              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1497              igwd, idx, itest, &              zulow, zvlow, 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)  
1498    
1499         !  ajout des tendances         ! ajout des tendances
1500         DO k = 1, llm         DO k = 1, llm
1501            DO i = 1, klon            DO i = 1, klon
1502               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 1507  contains
1507      ENDIF      ENDIF
1508    
1509      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1510           ! Sélection des points pour lesquels le schéma est actif :
1511         !  selection des points pour lesquels le shema est actif:         igwd = 0
1512         igwd=0         DO i = 1, klon
1513         DO i=1, klon            itest(i) = 0
1514            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1515            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1516               itest(i)=1               igwd = igwd + 1
1517               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1518            ENDIF            ENDIF
1519         ENDDO         ENDDO
1520    
1521         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1522              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, &  
1523              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1524    
1525         !  ajout des tendances         ! Ajout des tendances :
1526         DO k = 1, llm         DO k = 1, llm
1527            DO i = 1, klon            DO i = 1, klon
1528               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 1530  contains
1530               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)
1531            ENDDO            ENDDO
1532         ENDDO         ENDDO
1533        ENDIF
1534    
1535      ENDIF ! fin de test sur ok_orolf      ! Stress nécessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
1536    
1537      DO i = 1, klon      DO i = 1, klon
1538         zustrph(i)=0.         zustrph(i) = 0.
1539         zvstrph(i)=0.         zvstrph(i) = 0.
1540      ENDDO      ENDDO
1541      DO k = 1, llm      DO k = 1, llm
1542         DO i = 1, klon         DO i = 1, klon
1543            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 &
1544            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)                 * zmasse(i, k)
1545              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1546                   * zmasse(i, k)
1547         ENDDO         ENDDO
1548      ENDDO      ENDDO
1549    
1550      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1551             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1552      CALL aaam_bud(27, klon, llm, gmtime, &  
1553           ra, rg, romega, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1554           rlat, rlon, pphis, &           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1555           zustrdr, zustrli, zustrph, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1556           zvstrdr, zvstrli, zvstrph, &  
1557           paprs, u, v, &      ! Calcul des tendances traceurs
1558           aam, torsfc)      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1559             dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1560      IF (if_ebil >= 2) THEN           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1561         ztit='after orography'           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1562         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1563              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
1564              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1565      END IF           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1566             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
     ! Calcul  des tendances traceurs  
     call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nqmx-2, &  
          pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &  
          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  
1567    
1568      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1569      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 1571  contains
1571    
1572      ! diag. bilKP      ! diag. bilKP
1573    
1574      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, &  
1575           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1576    
1577      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1578    
1579      !+jld ec_conser      ! conversion Ec -> E thermique
1580      DO k = 1, llm      DO k = 1, llm
1581         DO i = 1, klon         DO i = 1, klon
1582            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1583            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1584                 *(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)
1585            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)
1586            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1587         END DO         END DO
1588      END DO      END DO
1589      !-jld ec_conser  
1590      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1591         ztit='after physic'         tit = 'after physic'
1592         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1593              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1594              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1595         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1596         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1597         !     est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1598         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1599         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1600              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1601              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1602    
1603         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1604    
1605      END IF      END IF
1606    
1607      !   SORTIES      ! SORTIES
1608    
1609      !cc prw = eau precipitable      ! prw = eau precipitable
1610      DO i = 1, klon      DO i = 1, klon
1611         prw(i) = 0.         prw(i) = 0.
1612         DO k = 1, llm         DO k = 1, llm
# Line 1870  contains Line 1618  contains
1618    
1619      DO k = 1, llm      DO k = 1, llm
1620         DO i = 1, klon         DO i = 1, klon
1621            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1622            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1623            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1624            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
1625            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
1626         ENDDO         ENDDO
1627      ENDDO      ENDDO
1628    
1629      IF (nqmx >= 3) THEN      IF (nqmx >= 3) THEN
1630         DO iq = 3, nqmx         DO iq = 3, nqmx
1631            DO  k = 1, llm            DO k = 1, llm
1632               DO  i = 1, klon               DO i = 1, klon
1633                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
1634               ENDDO               ENDDO
1635            ENDDO            ENDDO
1636         ENDDO         ENDDO
# Line 1896  contains Line 1644  contains
1644         ENDDO         ENDDO
1645      ENDDO      ENDDO
1646    
1647      !   Ecriture des sorties      ! Ecriture des sorties
1648      call write_histhf      call write_histhf
1649      call write_histday      call write_histday
1650      call write_histins      call write_histins
# Line 1904  contains Line 1652  contains
1652      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1653      IF (lafin) THEN      IF (lafin) THEN
1654         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1655         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1656              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1657              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1658              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1659              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1660      ENDIF      ENDIF
1661    
1662        firstcal = .FALSE.
1663    
1664    contains    contains
1665    
1666      subroutine write_histday      subroutine write_histday
1667    
1668        use gr_phy_write_3d_m, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1669        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1670    
1671        !------------------------------------------------        !------------------------------------------------
1672    
# Line 1940  contains Line 1688  contains
1688    
1689      subroutine write_histhf      subroutine write_histhf
1690    
1691        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09
1692    
1693        !------------------------------------------------        !------------------------------------------------
1694    
# Line 1956  contains Line 1704  contains
1704    
1705      subroutine write_histins      subroutine write_histins
1706    
1707        ! 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
1708    
1709        real zout        real zout
1710        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1711    
1712        !--------------------------------------------------        !--------------------------------------------------
1713    
1714        IF (ok_instan) THEN        IF (ok_instan) THEN
1715           ! Champs 2D:           ! Champs 2D:
1716    
1717           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1718           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1719           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1720    
1721           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1722           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)
1723           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1724    
1725           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1726           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)
1727           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1728    
1729           DO i = 1, klon           DO i = 1, klon
1730              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1731           ENDDO           ENDDO
1732           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)
1733           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1734    
1735           DO i = 1, klon           DO i = 1, klon
1736              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1737           ENDDO           ENDDO
1738           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)
1739           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1740    
1741           DO i = 1, klon           DO i = 1, klon
1742              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1743           ENDDO           ENDDO
1744           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)
1745           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1746    
1747           DO i = 1, klon           DO i = 1, klon
1748              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1749           ENDDO           ENDDO
1750           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)
1751           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1752    
1753           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)
1754           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1755           !ccIM           !ccIM
1756           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)
1757           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1758    
1759           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)
1760           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1761    
1762           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)
1763           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1764    
1765           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)
1766           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1767    
1768           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)
1769           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1770    
1771           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)
1772           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1773    
1774           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)
1775           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1776    
1777           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)
1778           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1779    
1780           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)
1781           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1782    
1783           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)
1784           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1785    
1786           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)
1787           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1788    
1789           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)
1790           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1791    
1792           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)
1793           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1794    
1795           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1796           !     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)
1797           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)
1798           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1799    
1800           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)
1801           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1802    
1803           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)
1804           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1805    
1806           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)
1807           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1808    
1809           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)
1810           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1811    
1812           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)
1813           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1814    
1815           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1816              !XXX              !XXX
1817              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1818              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)
1819              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1820                   zx_tmp_2d)                   zx_tmp_2d)
1821    
1822              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1823              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)
1824              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1825                   zx_tmp_2d)                   zx_tmp_2d)
1826    
1827              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1828              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)
1829              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1830                   zx_tmp_2d)                   zx_tmp_2d)
1831    
1832              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1833              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)
1834              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1835                   zx_tmp_2d)                   zx_tmp_2d)
1836    
1837              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1838              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)
1839              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1840                   zx_tmp_2d)                   zx_tmp_2d)
1841    
1842              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1843              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)
1844              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1845                   zx_tmp_2d)                   zx_tmp_2d)
1846    
1847              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1848              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)
1849              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1850                   zx_tmp_2d)                   zx_tmp_2d)
1851    
1852              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1853              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)
1854              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1855                   zx_tmp_2d)                   zx_tmp_2d)
1856    
1857              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1858              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)
1859              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1860                   zx_tmp_2d)                   zx_tmp_2d)
1861    
1862           END DO           END DO
1863           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)
1864           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1865           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)
1866           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1867    
1868           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)
1869           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1870    
          !IM cf. AM 081204 BEG  
   
1871           !HBTM2           !HBTM2
1872    
1873           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)
1874           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1875    
1876           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)
1877           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1878    
1879           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)
1880           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1881    
1882           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)
1883           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1884    
1885           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)
1886           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1887    
1888           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)
1889           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1890    
1891           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)
1892           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1893    
1894           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)
1895           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1896    
1897           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)
1898           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1899    
1900           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)
1901           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1902    
          !IM cf. AM 081204 END  
   
1903           ! Champs 3D:           ! Champs 3D:
1904    
1905           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)
1906           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1907    
1908           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)
1909           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1910    
1911           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)
1912           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1913    
1914           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)
1915           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1916    
1917           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)
1918           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1919    
1920           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)
1921           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1922    
1923           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)
1924           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1925    
1926           if (ok_sync) then           if (ok_sync) then
# Line 2190  contains Line 1934  contains
1934    
1935      subroutine write_histhf3d      subroutine write_histhf3d
1936    
1937        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09
1938    
1939        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1940    
1941        !-------------------------------------------------------        !-------------------------------------------------------
1942    
# Line 2200  contains Line 1944  contains
1944    
1945        ! Champs 3D:        ! Champs 3D:
1946    
1947        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)
1948        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
1949    
1950        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)
1951        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
1952    
1953        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)
1954        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
1955    
1956        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)
1957        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
1958    
1959        if (nbtr >= 3) then        if (nbtr >= 3) then
1960           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), &
1961                zx_tmp_3d)                zx_tmp_3d)
1962           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
1963        end if        end if

Legend:
Removed from v.34  
changed lines
  Added in v.78

  ViewVC Help
Powered by ViewVC 1.1.21