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

Diff of /trunk/phylmd/physiq.f

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

revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC revision 73 by guez, Fri Nov 15 17:48:30 2013 UTC
# Line 7  contains Line 7  contains
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! Author: Z.X. Li (LMD/CNRS) 1993      ! (subversion revision 678)
12    
13      ! Objet : moniteur général de la physique du modèle      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      use abort_gcm_m, only: abort_gcm      ! This is the main procedure for the "physics" part of the program.
     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 clmain_m, only: clmain  
     use comgeomphy  
     use concvl_m, only: concvl  
     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_m  
     use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
16    
17      ! Declaration des constantes et des fonctions thermodynamiques :      use aaam_bud_m, only: aaam_bud
18      use fcttre, only: thermcep, foeew, qsats, qsatl      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)
# Line 61  contains Line 75  contains
75      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
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):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 70  contains Line 84  contains
84      REAL, intent(in):: 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, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
90      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
91        
92      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
93      REAL t(klon, llm) ! input temperature (K)      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)
# Line 84  contains Line 98  contains
98      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
99      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
100      REAL, intent(out):: d_v(klon, llm) ! 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.      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, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
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)
# Line 159  contains Line 163  contains
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 '/
# Line 200  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 213  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 262  contains Line 263  contains
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
# Line 317  contains Line 315  contains
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 330  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
# Line 349  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
# Line 377  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)
# Line 392  contains Line 383  contains
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  
386      !KE43      !KE43
387      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
388      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
389      EXTERNAL transp ! transport total de l'eau et de l'energie      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
# Line 425  contains Line 411  contains
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        ! les variables soient rémanentes.
416        REAL, save:: heat(klon, llm) ! chauffage solaire
417      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
418      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
419      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
420      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
421      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface
422      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      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 454  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
# Line 501  contains Line 483  contains
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 519  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 542  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 574  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)
# Line 588  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
     SAVE d_h_vcol_phy  
575      REAL zero_v(klon)      REAL zero_v(klon)
576      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) tit
577      INTEGER ip_ebil ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
578      SAVE ip_ebil      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
579      DATA ip_ebil/0/  
580      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
     !+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)
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade=T -ADE=topswad-topsw  
604    
605      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
606      ! ok_aie=T ->      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_ade=T -AIE=topswai-topswad  
     ! ok_ade=F -AIE=topswai-topsw  
607    
608      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
609    
610      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
611      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
612      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
613        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
614        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
615        ! 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 663  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.
        rnebcon = 0.0  
        clwcon = 0.0  
674    
675         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
676         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 733  contains Line 683  contains
683         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
684         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
685    
686         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
687    
688         ! appel a la lecture du run.def physique         iflag_thermals = 0
689           nsplit_thermals = 1
690           print *, "Enter namelist 'physiq_nml'."
691           read(unit=*, nml=physiq_nml)
692           write(unit_nml, nml=physiq_nml)
693    
694         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys
             ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
695    
696         ! Initialiser les compteurs:         ! Initialiser les compteurs:
697    
# Line 750  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. / dtphys / 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 (dtphys*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, play)            CALL SUGWD(paprs, play)
734         else         else
735            rugoro = 0.            rugoro = 0.
736         ENDIF         ENDIF
# Line 819  contains Line 749  contains
749         npas = 0         npas = 0
750         nexca = 0         nexca = 0
751    
        print *,'AVANT HIST IFLAG_CON=', iflag_con  
   
752         ! Initialisation des sorties         ! Initialisation des sorties
753    
754         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
755         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
756         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, 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
# Line 882  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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
808              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
809              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, zero_v, zero_v, zero_v, zero_v, &         !  nulle.
815              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
816              d_qt, 0., fs_bound, fq_bound )              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
817                d_qt, 0., 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))/dtphys               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))/dtphys               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
   
     ! Mettre en action les conditions aux limites (albedo, sst, etc.).  
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
854    
855      if (nqmx >= 5) then      ! Mettre en action les conditions aux limites (albedo, sst etc.).
        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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
874              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
875              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
876         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
877              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
878              fs_bound, fq_bound )              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 997  contains Line 906  contains
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 1006  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    
# Line 1021  contains Line 930  contains
930    
931      ! Couche limite:      ! Couche limite:
932    
933      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
934           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
935           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
936           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
937           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
938           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
939           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
940           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
941           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
# Line 1034  contains Line 943  contains
943    
944      ! Incrémentation des flux      ! Incrémentation des flux
945    
946      zxfluxt=0.      zxfluxt = 0.
947      zxfluxq=0.      zxfluxq = 0.
948      zxfluxu=0.      zxfluxu = 0.
949      zxfluxv=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 1068  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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
978              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
979              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
980         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
981              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
982              fs_bound, fq_bound )              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 1147  contains Line 1049  contains
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)/dtphys            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)/dtphys  
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(dtphys, paprs, play, t_seri, q_seri, &  
             conv_t, conv_q, zxfluxq(1, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, &  
             pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
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, dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &  
                d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &  
                bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &  
                pmflxs, da, phi, mp)  
   
           clwcon0=qcondc  
           pmfu=upwd+dnwd  
        ELSE  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! 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)/play(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
# Line 1264  contains Line 1129  contains
1129                     zx_qs = qsatl(zx_t)/play(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 1287  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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1160              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1161              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1162         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1163              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1164              fs_bound, fq_bound )              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*dtphys         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))*dtphys) &  
                /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 (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1203         ! Ajustement sec         ! Ajustement sec
# Line 1355  contains Line 1211  contains
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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1216              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1217              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)-play(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(-dtphys*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(dtphys, paprs, play, &           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 1423  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*dtphys         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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1291              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1292              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1293         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1294              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1295              fs_bound, fq_bound )              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)/dtphys &                     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 1466  contains Line 1317  contains
1317         endif         endif
1318    
1319         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1320         CALL diagcld1(paprs, play, &         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 = dtphys *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, play, 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 1515  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, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             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)
# Line 1547  contains Line 1390  contains
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(play, 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, play, 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, play, &         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 1602  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, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1436              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1437              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1617  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)) * dtphys/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, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1456              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1457              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1458         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1459              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1460              fs_bound, fq_bound )              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 1645  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, dtphys, paprs, play, &         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
# Line 1685  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    
# Line 1701  contains Line 1522  contains
1522              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 1709  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))/dtphys* 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))/dtphys* 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    
1553      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1554           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1555           aam, torsfc)           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
   
     IF (if_ebil >= 2) THEN  
        ztit='after orography'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1556    
1557      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1558      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1559           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &
1560           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1561           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1562           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
          tr_seri, zmasse)  
1563    
1564      IF (offline) THEN      IF (offline) THEN
1565         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &
1566              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1567              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1568      ENDIF      ENDIF
# Line 1758  contains Line 1573  contains
1573    
1574      ! diag. bilKP      ! diag. bilKP
1575    
1576      CALL transp_lay (paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
1577           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1578    
1579      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1580    
1581      !+jld ec_conser      ! conversion Ec -> E thermique
1582      DO k = 1, llm      DO k = 1, llm
1583         DO i = 1, klon         DO i = 1, klon
1584            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1585            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1586                 *(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)
1587            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)
1588            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1589         END DO         END DO
1590      END DO      END DO
1591      !-jld ec_conser  
1592      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1593         ztit='after physic'         tit = 'after physic'
1594         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1595              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1596              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1597         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1598         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1599         ! 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.
1600         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1601         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1602              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1603              fs_bound, fq_bound )              fs_bound, fq_bound)
1604    
1605         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1606    
1607      END IF      END IF
1608    
1609      ! SORTIES      ! SORTIES
1610    
1611      !cc prw = eau precipitable      ! prw = eau precipitable
1612      DO i = 1, klon      DO i = 1, klon
1613         prw(i) = 0.         prw(i) = 0.
1614         DO k = 1, llm         DO k = 1, llm
# Line 1805  contains Line 1620  contains
1620    
1621      DO k = 1, llm      DO k = 1, llm
1622         DO i = 1, klon         DO i = 1, klon
1623            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1624            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1625            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1626            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1627            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1628         ENDDO         ENDDO
1629      ENDDO      ENDDO
1630    
# Line 1839  contains Line 1654  contains
1654      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1655      IF (lafin) THEN      IF (lafin) THEN
1656         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1657         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1658              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1659              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1660              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1661              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)  
1662      ENDIF      ENDIF
1663    
1664      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1908  contains Line 1721  contains
1721           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1722    
1723           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1724           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)
1725           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1726    
1727           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1728           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)
1729           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1730    
1731           DO i = 1, klon           DO i = 1, klon
1732              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1733           ENDDO           ENDDO
1734           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)
1735           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1736    
1737           DO i = 1, klon           DO i = 1, klon
1738              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1739           ENDDO           ENDDO
1740           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)
1741           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1742    
1743           DO i = 1, klon           DO i = 1, klon
1744              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1745           ENDDO           ENDDO
1746           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)
1747           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1748    
1749           DO i = 1, klon           DO i = 1, klon
1750              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1751           ENDDO           ENDDO
1752           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)
1753           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1754    
1755           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)
1756           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1757           !ccIM           !ccIM
1758           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)
1759           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1760    
1761           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)
1762           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1763    
1764           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)
1765           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1766    
1767           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)
1768           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1769    
1770           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)
1771           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1772    
1773           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)
1774           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1775    
1776           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)
1777           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1778    
1779           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)
1780           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1781    
1782           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)
1783           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1784    
1785           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)
1786           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1787    
1788           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)
1789           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1790    
1791           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)
1792           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1793    
1794           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)
1795           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1796    
1797           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1798           ! 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)
1799           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)
1800           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1801    
1802           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)
1803           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1804    
1805           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)
1806           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1807    
1808           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)
1809           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1810    
1811           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)
1812           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1813    
1814           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)
1815           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1816    
1817           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1818              !XXX              !XXX
1819              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1820              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)
1821              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1822                   zx_tmp_2d)                   zx_tmp_2d)
1823    
1824              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1825              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)
1826              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1827                   zx_tmp_2d)                   zx_tmp_2d)
1828    
1829              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1830              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)
1831              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1832                   zx_tmp_2d)                   zx_tmp_2d)
1833    
1834              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1835              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)
1836              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1837                   zx_tmp_2d)                   zx_tmp_2d)
1838    
1839              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1840              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)
1841              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1842                   zx_tmp_2d)                   zx_tmp_2d)
1843    
1844              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1845              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)
1846              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1847                   zx_tmp_2d)                   zx_tmp_2d)
1848    
1849              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1850              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)
1851              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1852                   zx_tmp_2d)                   zx_tmp_2d)
1853    
1854              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1855              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)
1856              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1857                   zx_tmp_2d)                   zx_tmp_2d)
1858    
1859              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1860              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)
1861              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1862                   zx_tmp_2d)                   zx_tmp_2d)
1863    
1864           END DO           END DO
1865           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)
1866           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1867           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)
1868           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1869    
1870           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)
1871           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1872    
          !IM cf. AM 081204 BEG  
   
1873           !HBTM2           !HBTM2
1874    
1875           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)
1876           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1877    
1878           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)
1879           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1880    
1881           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)
1882           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1883    
1884           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)
1885           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1886    
1887           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)
1888           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1889    
1890           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)
1891           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1892    
1893           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)
1894           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1895    
1896           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)
1897           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1898    
1899           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)
1900           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1901    
1902           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)
1903           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1904    
          !IM cf. AM 081204 END  
   
1905           ! Champs 3D:           ! Champs 3D:
1906    
1907           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)
1908           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1909    
1910           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)
1911           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1912    
1913           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)
1914           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1915    
1916           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)
1917           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1918    
1919           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), play, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
1920           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1921    
1922           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)
1923           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1924    
1925           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)
1926           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1927    
1928           if (ok_sync) then           if (ok_sync) then
# Line 2137  contains Line 1946  contains
1946    
1947        ! Champs 3D:        ! Champs 3D:
1948    
1949        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)
1950        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
1951    
1952        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)
1953        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
1954    
1955        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)
1956        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
1957    
1958        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)
1959        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
1960    
1961        if (nbtr >= 3) then        if (nbtr >= 3) then
1962           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), &
1963                zx_tmp_3d)                zx_tmp_3d)
1964           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
1965        end if        end if

Legend:
Removed from v.47  
changed lines
  Added in v.73

  ViewVC Help
Powered by ViewVC 1.1.21