/[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 56 by guez, Tue Jan 10 19:02:02 2012 UTC
# Line 10  contains Line 10  contains
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 (SVN revision 678)
11      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
12    
13      ! Objet : moniteur général de la physique du modèle      ! This is the main procedure for the "physics" part of the program.
14    
15      use abort_gcm_m, only: abort_gcm      use aaam_bud_m, only: aaam_bud
16      USE calendar, only: ymds2ju      USE abort_gcm_m, ONLY: abort_gcm
17      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &      use ajsec_m, only: ajsec
18           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      USE calendar, ONLY: ymds2ju
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use calltherm_m, only: calltherm
20           cycle_diurne, new_oliq, soil_model      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
21      use clmain_m, only: clmain           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
22      use comgeomphy      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
23      use concvl_m, only: concvl           ok_orodr, ok_orolf, soil_model
24      use conf_gcm_m, only: raz_date, offline      USE clmain_m, ONLY: clmain
25      use conf_phys_m, only: conf_phys      USE comgeomphy, ONLY: airephy, cuphy, cvphy
26      use ctherm      USE concvl_m, ONLY: concvl
27      use dimens_m, only: jjm, iim, llm, nqmx      USE conf_gcm_m, ONLY: offline, raz_date
28      use dimphy, only: klon, nbtr      USE conf_phys_m, ONLY: conf_phys
29      use dimsoil, only: nsoilmx      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
30      use hgardfou_m, only: hgardfou      use diagcld2_m, only: diagcld2
31      USE histcom, only: histsync      use diagetpq_m, only: diagetpq
32      USE histwrite_m, only: histwrite      USE dimens_m, ONLY: iim, jjm, llm, nqmx
33      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      USE dimphy, ONLY: klon, nbtr
34      use ini_histhf_m, only: ini_histhf      USE dimsoil, ONLY: nsoilmx
35      use ini_histday_m, only: ini_histday      use drag_noro_m, only: drag_noro
36      use ini_histins_m, only: ini_histins      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
37      use iniprint, only: prt_level      USE hgardfou_m, ONLY: hgardfou
38      use oasis_m      USE histcom, ONLY: histsync
39      use orbite_m, only: orbite, zenang      USE histwrite_m, ONLY: histwrite
40      use ozonecm_m, only: ozonecm      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
41      use phyetat0_m, only: phyetat0, rlat, rlon           nbsrf
42      use phyredem_m, only: phyredem      USE ini_histhf_m, ONLY: ini_histhf
43      use phystokenc_m, only: phystokenc      USE ini_histday_m, ONLY: ini_histday
44      use phytrac_m, only: phytrac      USE ini_histins_m, ONLY: ini_histins
45      use qcheck_m, only: qcheck      USE oasis_m, ONLY: ok_oasis
46      use radepsi      USE orbite_m, ONLY: orbite, zenang
47      use radopt      USE ozonecm_m, ONLY: ozonecm
48      use temps, only: itau_phy, day_ref, annee_ref      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
49      use yoethf_m      USE phyredem_m, ONLY: phyredem
50      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE phystokenc_m, ONLY: phystokenc
51        USE phytrac_m, ONLY: phytrac
52        USE qcheck_m, ONLY: qcheck
53        use radlwsw_m, only: radlwsw
54        use sugwd_m, only: sugwd
55        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
56        USE temps, ONLY: annee_ref, day_ref, itau_phy
57        USE yoethf_m, ONLY: r2es, rvtmp2
58    
59      ! Declaration des constantes et des fonctions thermodynamiques :      ! Arguments:
     use fcttre, only: thermcep, foeew, qsats, qsatl  
   
     ! Variables argument:  
60    
61      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
62      ! (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 65  contains
65      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
66      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
67    
68      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
69      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
70    
71      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 70  contains Line 74  contains
74      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
75      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
76    
77      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
78    
79      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
80      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
81        
82      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
83      REAL t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
84    
85      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
86      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
# Line 84  contains Line 88  contains
88      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
89      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)
90      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)
91      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)
92      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)
93      REAL d_ps(klon) ! output tendance physique de la pression au sol      REAL d_ps(klon) ! output tendance physique de la pression au sol
94    
95      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
96    
97      INTEGER nbteta      INTEGER nbteta
98      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
99    
100      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
101      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
102    
103      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
104      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
105      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
106      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
107    
108      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
109      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
110      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
111      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
112        ! Ajouter artificiellement les stratus
113    
114      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
115      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
116      logical rnpb      logical rnpb
117      parameter(rnpb=.true.)      parameter(rnpb = .true.)
118    
119      character(len=6), save:: ocean      character(len = 6), save:: ocean
120      ! (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")
121    
122      logical ok_ocean      logical ok_ocean
123      SAVE ok_ocean      SAVE ok_ocean
124    
125      !IM "slab" ocean      ! "slab" ocean
126      REAL tslab(klon) !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
127      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
128      REAL seaice(klon) !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
129      SAVE seaice      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxo(klon) !flux turbulents ocean-glace de mer  
     REAL fluxg(klon) !flux turbulents ocean-atmosphere  
130    
131      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
132      logical, save:: ok_veget      logical, save:: ok_veget
# Line 135  contains Line 138  contains
138      save ok_instan      save ok_instan
139    
140      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
141      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
142    
143      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
144      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
145      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
146      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
147    
148      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
149      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
150      INTEGER iliq ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
151      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
152    
153      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
154      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
155    
156      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
157      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 160  contains
160    
161      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
162    
163      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
164      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
165      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
166      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 167  contains Line 168  contains
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      INTEGER klevp1
171      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
172    
173      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
174      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
# Line 181  contains Line 182  contains
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, 0.3, 1.3, 3.6, 9.4, 23., 60./
# 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 fevap(klon, nbsrf)
272      SAVE fevap ! evaporation      SAVE fevap ! evaporation
# Line 276  contains Line 276  contains
276      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
277      SAVE fqsurf ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
278    
279      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol ! hauteur d'eau dans le sol  
280    
281      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
282      SAVE fsnow ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
# Line 392  contains Line 391  contains
391      ! Declaration des procedures appelees      ! Declaration des procedures appelees
392    
393      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec ! ajustement sec  
394      !KE43      !KE43
395      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
396      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
397      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
398      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
399    
400      ! Variables locales      ! Variables locales
# Line 425  contains Line 422  contains
422      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
423      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
424    
425      REAL heat(klon, llm) ! chauffage solaire      ! Le rayonnement n'est pas calcule tous les pas, il faut donc
426        ! que les variables soient rémanentes
427        REAL, save:: heat(klon, llm) ! chauffage solaire
428      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
429      REAL cool(klon, llm) ! refroidissement infrarouge      REAL cool(klon, llm) ! refroidissement infrarouge
430      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
# Line 435  contains Line 434  contains
434      REAL albpla(klon)      REAL albpla(klon)
435      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
436      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
437      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown
     ! sauvegarder les sorties du rayonnement  
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
438      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0
439    
440      INTEGER itaprad      INTEGER itaprad
441      SAVE itaprad      SAVE itaprad
442    
443      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
444      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
445    
446      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
447      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 459  contains Line 456  contains
456      LOGICAL zx_ajustq      LOGICAL zx_ajustq
457    
458      REAL za, zb      REAL za, zb
459      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
460      real zqsat(klon, llm)      real zqsat(klon, llm)
461      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
462      REAL t_coup      REAL t_coup
463      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
464    
465      REAL zphi(klon, llm)      REAL zphi(klon, llm)
466    
467      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
468    
469      REAL pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
470      REAL plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
471      REAL capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
472      REAL oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
473      REAL cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
474      REAL pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
475      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
476      REAL trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
477      REAL trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
478      REAL trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
479      ! Grdeurs de sorties      ! Grdeurs de sorties
480      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
481      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 508  contains Line 505  contains
505      ! Variables du changement      ! Variables du changement
506    
507      ! con: convection      ! con: convection
508      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
509      ! ajs: ajustement sec      ! ajs: ajustement sec
510      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
511      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
512      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
513      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
514      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 523  contains Line 520  contains
520      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
521      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
522      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
523      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
524      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)  
525    
526      SAVE ibas_con, itop_con      INTEGER,save:: ibas_con(klon), itop_con(klon)
527    
528      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
529      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 558  contains Line 553  contains
553    
554      logical ptconv(klon, llm)      logical ptconv(klon, llm)
555    
556      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en série :
557    
558      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
559      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 574  contains Line 569  contains
569      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
570      REAL aam, torsfc      REAL aam, torsfc
571    
572      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
573    
574      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
575      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 583  contains
583    
584      REAL zsto      REAL zsto
585    
586      character(len=20) modname      character(len = 20) modname
587      character(len=80) abort_message      character(len = 80) abort_message
588      logical ok_sync      logical ok_sync
589      real date0      real date0
590    
591      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
592      REAL ztsol(klon)      REAL ztsol(klon)
593      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
594      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
595      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
     SAVE d_h_vcol_phy  
596      REAL zero_v(klon)      REAL zero_v(klon)
597      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) ztit
598      INTEGER ip_ebil ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
     SAVE ip_ebil  
     DATA ip_ebil/0/  
599      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
600      !+jld ec_conser  
601      REAL d_t_ec(klon, llm) ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
602      REAL ZRCPD      REAL ZRCPD
603      !-jld ec_conser  
604      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) !temperature, humidite a 2m  
605      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
606      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
607      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
608      !jq Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
609      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
610    
611      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
612      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
613    
614      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
615      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
# Line 632  contains Line 622  contains
622      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
623    
624      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
625      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
626    
627      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
628      ! ok_aie=T ->      ! ok_aie = True ->
629      ! ok_ade=T -AIE=topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
630      ! ok_ade=F -AIE=topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
631    
632      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
633    
# Line 665  contains Line 655  contains
655      SAVE d_v_con      SAVE d_v_con
656      SAVE rnebcon0      SAVE rnebcon0
657      SAVE clwcon0      SAVE clwcon0
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
658    
659      real zmasse(klon, llm)      real zmasse(klon, llm)
660      ! (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)
# Line 685  contains Line 665  contains
665    
666      modname = 'physiq'      modname = 'physiq'
667      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
668         DO i=1, klon         DO i = 1, klon
669            zero_v(i)=0.            zero_v(i) = 0.
670         END DO         END DO
671      END IF      END IF
672      ok_sync=.TRUE.      ok_sync = .TRUE.
673      IF (nqmx < 2) THEN      IF (nqmx < 2) THEN
674         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
675         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
# Line 697  contains Line 677  contains
677    
678      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
679         ! initialiser         ! initialiser
680         u10m=0.         u10m = 0.
681         v10m=0.         v10m = 0.
682         t2m=0.         t2m = 0.
683         q2m=0.         q2m = 0.
684         ffonte=0.         ffonte = 0.
685         fqcalving=0.         fqcalving = 0.
686         piz_ae=0.         piz_ae = 0.
687         tau_ae=0.         tau_ae = 0.
688         cg_ae=0.         cg_ae = 0.
689         rain_con(:)=0.         rain_con(:) = 0.
690         snow_con(:)=0.         snow_con(:) = 0.
691         bl95_b0=0.         bl95_b0 = 0.
692         bl95_b1=0.         bl95_b1 = 0.
693         topswai(:)=0.         topswai(:) = 0.
694         topswad(:)=0.         topswad(:) = 0.
695         solswai(:)=0.         solswai(:) = 0.
696         solswad(:)=0.         solswad(:) = 0.
697    
698         d_u_con = 0.0         d_u_con = 0.0
699         d_v_con = 0.0         d_v_con = 0.0
# Line 733  contains Line 713  contains
713         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
714         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
715    
716         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
717    
718         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
719    
# Line 750  contains Line 730  contains
730         itap = 0         itap = 0
731         itaprad = 0         itaprad = 0
732         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
733              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
734              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
735              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
736              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0)  
737    
738         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
739         q2=1.e-8         q2 = 1.e-8
740    
741         radpas = NINT( 86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
742    
743         ! on remet le calendrier a zero         ! on remet le calendrier a zero
744         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 768  contains Line 746  contains
746         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
747    
748         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
749            ok_ocean=.TRUE.            ok_ocean = .TRUE.
750         ENDIF         ENDIF
751    
752         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
753              ok_region)              ok_region)
754    
755         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
756            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
757            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
758            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
759            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
760         ENDIF         ENDIF
761         print *,"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con = ", iflag_con
762         print *,"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl = ", &
763              ok_cvl              ok_cvl
764    
765         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
# Line 800  contains Line 778  contains
778    
779         IF (ok_orodr) THEN         IF (ok_orodr) THEN
780            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
781            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
782         else         else
783            rugoro = 0.            rugoro = 0.
784         ENDIF         ENDIF
# Line 819  contains Line 797  contains
797         npas = 0         npas = 0
798         nexca = 0         nexca = 0
799    
800         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
801    
802         ! Initialisation des sorties         ! Initialisation des sorties
803    
# Line 828  contains Line 806  contains
806         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
807         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
808         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
809         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
810      ENDIF test_firstcal      ENDIF test_firstcal
811    
812      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 836  contains Line 814  contains
814      DO i = 1, klon      DO i = 1, klon
815         d_ps(i) = 0.0         d_ps(i) = 0.0
816      ENDDO      ENDDO
     DO k = 1, llm  
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
817      DO iq = 1, nqmx      DO iq = 1, nqmx
818         DO k = 1, llm         DO k = 1, llm
819            DO i = 1, klon            DO i = 1, klon
# Line 850  contains Line 821  contains
821            ENDDO            ENDDO
822         ENDDO         ENDDO
823      ENDDO      ENDDO
824      da=0.      da = 0.
825      mp=0.      mp = 0.
826      phi=0.      phi = 0.
827    
828      ! 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 :
829    
830      DO k = 1, llm      DO k = 1, llm
831         DO i = 1, klon         DO i = 1, klon
# Line 882  contains Line 853  contains
853      ENDDO      ENDDO
854    
855      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
856         ztit='after dynamic'         ztit = 'after dynamics'
857         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
858              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, &
859              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
860         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
861         ! on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
862         ! est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
863         ! Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
864           !  nulle.
865         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
866              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
867              d_qt, 0., fs_bound, fq_bound )              d_qt, 0., fs_bound, fq_bound)
868      END IF      END IF
869    
870      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
871      IF (ancien_ok) THEN      IF (ancien_ok) THEN
872         DO k = 1, llm         DO k = 1, llm
873            DO i = 1, klon            DO i = 1, klon
874               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
875               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
876            ENDDO            ENDDO
877         ENDDO         ENDDO
878      ELSE      ELSE
# Line 915  contains Line 886  contains
886      ENDIF      ENDIF
887    
888      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
889      DO k = 1, llm      DO k = 1, llm
890         DO i = 1, klon         DO i = 1, klon
891            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
892         ENDDO         ENDDO
893      ENDDO      ENDDO
894    
895      ! Verifier les temperatures      ! Check temperatures:
   
896      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
897    
898      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
899      itap = itap + 1      itap = itap + 1
900      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
901      if (julien == 0) julien = 360      if (julien == 0) julien = 360
902    
903      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
904    
905      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
906    
907        ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
908      if (nqmx >= 5) then      if (nqmx >= 5) then
909         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
910      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
911         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
912      ENDIF      ENDIF
913    
914      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
915        DO k = 1, llm
     DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse  
916         DO i = 1, klon         DO i = 1, klon
917            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
918            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
919            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  
920            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
921         ENDDO         ENDDO
922      ENDDO      ENDDO
923        ql_seri = 0.
924    
925      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
926         ztit='after reevap'         ztit = 'after reevap'
927         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
928              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, &
929              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
930         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
931              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, &
932              fs_bound, fq_bound )              fs_bound, fq_bound)
933    
934      END IF      END IF
935    
# Line 997  contains Line 960  contains
960      ENDIF      ENDIF
961    
962      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
963      albsol(:)=0.      albsol(:) = 0.
964      albsollw(:)=0.      albsollw(:) = 0.
965      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
966         DO i = 1, klon         DO i = 1, klon
967            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1034  contains Line 997  contains
997    
998      ! Incrémentation des flux      ! Incrémentation des flux
999    
1000      zxfluxt=0.      zxfluxt = 0.
1001      zxfluxq=0.      zxfluxq = 0.
1002      zxfluxu=0.      zxfluxu = 0.
1003      zxfluxv=0.      zxfluxv = 0.
1004      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1005         DO k = 1, llm         DO k = 1, llm
1006            DO i = 1, klon            DO i = 1, klon
1007               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + &
1008                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1009               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxq(i, k) = zxfluxq(i, k) + &
1010                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1011               zxfluxu(i, k) = zxfluxu(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + &
1012                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1013               zxfluxv(i, k) = zxfluxv(i, k) + &               zxfluxv(i, k) = zxfluxv(i, k) + &
1014                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1015            END DO            END DO
1016         END DO         END DO
1017      END DO      END DO
# Line 1068  contains Line 1031  contains
1031      ENDDO      ENDDO
1032    
1033      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1034         ztit='after clmain'         ztit = 'after clmain'
1035         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1036              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, &
1037              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1038         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1039              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, &
1040              fs_bound, fq_bound )              fs_bound, fq_bound)
1041      END IF      END IF
1042    
1043      ! Incrementer la temperature du sol      ! Update surface temperature:
1044    
1045      DO i = 1, klon      DO i = 1, klon
1046         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1101  contains Line 1064  contains
1064         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1065         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1066    
1067         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1068              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1069              THEN              THEN
1070            WRITE(*, *) 'physiq : pb sous surface au point ', i, &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1071                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
# Line 1147  contains Line 1110  contains
1110            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1111            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
1112                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1113            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1114            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1115            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1116            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1117            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1118            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1119            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1120            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1121            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1122            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1123         ENDDO         ENDDO
1124      ENDDO      ENDDO
1125    
# Line 1178  contains Line 1141  contains
1141      ENDDO      ENDDO
1142      IF (check) THEN      IF (check) THEN
1143         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1144         print *, "avantcon=", za         print *, "avantcon = ", za
1145      ENDIF      ENDIF
1146      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1147      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1148      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1149         DO i = 1, klon         DO i = 1, klon
1150            z_avant(i) = 0.0            z_avant(i) = 0.0
1151         ENDDO         ENDDO
1152         DO k = 1, llm         DO k = 1, llm
1153            DO i = 1, klon            DO i = 1, klon
1154               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &
1155                    *zmasse(i, k)                    *zmasse(i, k)
1156            ENDDO            ENDDO
1157         ENDDO         ENDDO
1158      ENDIF      ENDIF
1159      IF (iflag_con == 1) THEN  
1160         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1161      ELSE IF (iflag_con == 2) THEN      case (1)
1162         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1163              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1164              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1165              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1166              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1167                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1168                pmflxs)
1169         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1170         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1171         DO i = 1, klon         DO i = 1, klon
1172            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1173            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1174         ENDDO         ENDDO
1175      ELSE IF (iflag_con >= 3) THEN      case (3:)
1176         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1177         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1178         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1179         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1180         ntra = 1         ntra = 1
1181         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1182         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1183    
1184         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1185              ! new driver for convectL
1186            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1187                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1188                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1189                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1190                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1191                 pmflxs, da, phi, mp)                 pmflxs, da, phi, mp)
1192              clwcon0 = qcondc
1193            clwcon0=qcondc            pmfu = upwd + dnwd
           pmfu=upwd+dnwd  
1194         ELSE         ELSE
1195            ! MAF conema3 ne contient pas les traceurs            ! conema3 ne contient pas les traceurs
1196            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &            CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1197                 u_seri, v_seri, tr_seri, ntra, &                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1198                 ema_work1, ema_work2, &                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1199                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &
1200                 rain_con, snow_con, ibas_con, itop_con, &                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1201                 upwd, dnwd, dnwd0, bas, top, &         ENDIF
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
1202    
1203         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1204            do i = 1, klon            do i = 1, klon
1205               wd(i)=0.0               wd(i) = 0.0
1206            enddo            enddo
1207         ENDIF         ENDIF
1208    
1209         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1210    
1211         DO k = 1, llm         DO k = 1, llm
1212            DO i = 1, klon            DO i = 1, klon
# Line 1264  contains Line 1224  contains
1224                     zx_qs = qsatl(zx_t)/play(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1225                  ENDIF                  ENDIF
1226               ENDIF               ENDIF
1227               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1228            ENDDO            ENDDO
1229         ENDDO         ENDDO
1230    
1231         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1232         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1233         call clouds_gno &         call clouds_gno &
1234              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1235      ELSE      case default
1236         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1237         stop 1         stop 1
1238      ENDIF      END select
1239    
1240      DO k = 1, llm      DO k = 1, llm
1241         DO i = 1, klon         DO i = 1, klon
# Line 1287  contains Line 1247  contains
1247      ENDDO      ENDDO
1248    
1249      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1250         ztit='after convect'         ztit = 'after convect'
1251         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1252              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, &
1253              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1254         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1255              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, &
1256              fs_bound, fq_bound )              fs_bound, fq_bound)
1257      END IF      END IF
1258    
1259      IF (check) THEN      IF (check) THEN
1260         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1261         print *,"aprescon=", za         print *,"aprescon = ", za
1262         zx_t = 0.0         zx_t = 0.0
1263         za = 0.0         za = 0.0
1264         DO i = 1, klon         DO i = 1, klon
# Line 1307  contains Line 1267  contains
1267                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1268         ENDDO         ENDDO
1269         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1270         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1271      ENDIF      ENDIF
1272      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1273         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 1275  contains
1275         ENDDO         ENDDO
1276         DO k = 1, llm         DO k = 1, llm
1277            DO i = 1, klon            DO i = 1, klon
1278               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &
1279                    *zmasse(i, k)                    *zmasse(i, k)
1280            ENDDO            ENDDO
1281         ENDDO         ENDDO
1282         DO i = 1, klon         DO i = 1, klon
1283            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1284                 /z_apres(i)                 /z_apres(i)
1285         ENDDO         ENDDO
1286         DO k = 1, llm         DO k = 1, llm
1287            DO i = 1, klon            DO i = 1, klon
1288               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  
1289                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1290               ENDIF               ENDIF
1291            ENDDO            ENDDO
1292         ENDDO         ENDDO
1293      ENDIF      ENDIF
1294      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1295    
1296      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1297    
1298      d_t_ajs=0.      d_t_ajs = 0.
1299      d_u_ajs=0.      d_u_ajs = 0.
1300      d_v_ajs=0.      d_v_ajs = 0.
1301      d_q_ajs=0.      d_q_ajs = 0.
1302      fm_therm=0.      fm_therm = 0.
1303      entr_therm=0.      entr_therm = 0.
1304    
1305      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1306         ! Ajustement sec         ! Ajustement sec
# Line 1355  contains Line 1314  contains
1314      endif      endif
1315    
1316      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1317         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1318         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1319              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, &
1320              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1363  contains Line 1322  contains
1322    
1323      ! Caclul des ratqs      ! Caclul des ratqs
1324    
1325      ! ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q
1326      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1327      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1328         do k=1, llm         do k = 1, llm
1329            do i=1, klon            do i = 1, klon
1330               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1331                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1332                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1333               else               else
1334                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1335               endif               endif
1336            enddo            enddo
1337         enddo         enddo
1338      endif      endif
1339    
1340      ! ratqs stables      ! ratqs stables
1341      do k=1, llm      do k = 1, llm
1342         do i=1, klon         do i = 1, klon
1343            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1344                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1345         enddo         enddo
1346      enddo      enddo
# Line 1392  contains Line 1351  contains
1351         ! ratqs final         ! ratqs final
1352         ! 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
1353         ! relaxation des ratqs         ! relaxation des ratqs
1354         facteur=exp(-dtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1355         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1356         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1357      else      else
1358         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1359         ratqs=ratqss         ratqs = ratqss
1360      endif      endif
1361    
1362      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1363      ! et le processus de precipitation      ! précipitation :
1364      CALL fisrtilp(dtphys, paprs, play, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1365           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1366           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1367           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1368    
1369      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1370      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1423  contains Line 1379  contains
1379      ENDDO      ENDDO
1380      IF (check) THEN      IF (check) THEN
1381         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1382         print *,"apresilp=", za         print *,"apresilp = ", za
1383         zx_t = 0.0         zx_t = 0.0
1384         za = 0.0         za = 0.0
1385         DO i = 1, klon         DO i = 1, klon
# Line 1432  contains Line 1388  contains
1388                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1389         ENDDO         ENDDO
1390         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1391         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1392      ENDIF      ENDIF
1393    
1394      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1395         ztit='after fisrt'         ztit = 'after fisrt'
1396         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1397              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, &
1398              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1399         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1400              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, &
1401              fs_bound, fq_bound )              fs_bound, fq_bound)
1402      END IF      END IF
1403    
1404      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
# Line 1450  contains Line 1406  contains
1406      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1407    
1408      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1409         snow_tiedtke=0.         snow_tiedtke = 0.
1410         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1411            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1412         else         else
1413            rain_tiedtke=0.            rain_tiedtke = 0.
1414            do k=1, llm            do k = 1, llm
1415               do i=1, klon               do i = 1, klon
1416                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1417                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1418                          *zmasse(i, k)                          *zmasse(i, k)
1419                  endif                  endif
1420               enddo               enddo
# Line 1471  contains Line 1427  contains
1427              diafra, dialiq)              diafra, dialiq)
1428         DO k = 1, llm         DO k = 1, llm
1429            DO i = 1, klon            DO i = 1, klon
1430               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1431                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1432                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1433               ENDIF               ENDIF
1434            ENDDO            ENDDO
1435         ENDDO         ENDDO
   
1436      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1437         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1438         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1439         ! facttemps         ! facttemps
1440         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1441         do k=1, llm         do k = 1, llm
1442            do i=1, klon            do i = 1, klon
1443               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1444               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1445                    then                    then
1446                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1447                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1448               endif               endif
1449            enddo            enddo
1450         enddo         enddo
1451    
1452         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1453         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1454         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1455      ENDIF      ENDIF
1456    
1457      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1458    
1459      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1460         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1461         DO k = 1, llm         DO k = 1, llm
1462            DO i = 1, klon            DO i = 1, klon
1463               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1464                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1465                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1466               ENDIF               ENDIF
# Line 1522  contains Line 1476  contains
1476      ENDDO      ENDDO
1477    
1478      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1479         ztit="after diagcld"         ztit = "after diagcld"
1480         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1481              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, &
1482              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1483      END IF      END IF
1484    
1485      ! Calculer l'humidite relative pour diagnostique      ! Humidité relative pour diagnostic:
   
1486      DO k = 1, llm      DO k = 1, llm
1487         DO i = 1, klon         DO i = 1, klon
1488            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1547  contains Line 1500  contains
1500               ENDIF               ENDIF
1501            ENDIF            ENDIF
1502            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1503            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1504         ENDDO         ENDDO
1505      ENDDO      ENDDO
1506      !jq - introduce the aerosol direct and first indirect radiative forcings  
1507      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1508      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1509        IF (ok_ade .OR. ok_aie) THEN
1510         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1511         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1512         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1513    
1514         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1515         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1516              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1517      ELSE      ELSE
1518         tau_ae=0.0         tau_ae = 0.
1519         piz_ae=0.0         piz_ae = 0.
1520         cg_ae=0.0         cg_ae = 0.
1521      ENDIF      ENDIF
1522    
1523      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour
1524      ! parametres pour diagnostiques:      ! diagnostics :
   
1525      if (ok_newmicro) then      if (ok_newmicro) then
1526         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1527              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1528              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1529              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1530      else      else
1531         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1532              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1533              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1534      endif      endif
1535    
1536      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1537      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1538         DO i = 1, klon         DO i = 1, klon
1539            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1617  contains Line 1560  contains
1560    
1561      DO k = 1, llm      DO k = 1, llm
1562         DO i = 1, klon         DO i = 1, klon
1563            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.  
1564         ENDDO         ENDDO
1565      ENDDO      ENDDO
1566    
1567      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1568         ztit='after rad'         ztit = 'after rad'
1569         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1570              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, &
1571              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1572         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1573              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, &
1574              fs_bound, fq_bound )              fs_bound, fq_bound)
1575      END IF      END IF
1576    
1577      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1578      DO i = 1, klon      DO i = 1, klon
1579         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1580         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1645  contains Line 1586  contains
1586         ENDDO         ENDDO
1587      ENDDO      ENDDO
1588    
1589      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1590    
1591      DO i = 1, klon      DO i = 1, klon
1592         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1593      ENDDO      ENDDO
1594    
1595      !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:  
1596    
1597      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1598         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1599         igwd=0         igwd = 0
1600         DO i=1, klon         DO i = 1, klon
1601            itest(i)=0            itest(i) = 0
1602            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1603               itest(i)=1               itest(i) = 1
1604               igwd=igwd+1               igwd = igwd + 1
1605               idx(igwd)=i               idx(igwd) = i
1606            ENDIF            ENDIF
1607         ENDDO         ENDDO
1608    
1609         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1610              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1611              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)  
1612    
1613         ! ajout des tendances         ! ajout des tendances
1614         DO k = 1, llm         DO k = 1, llm
# Line 1685  contains Line 1621  contains
1621      ENDIF      ENDIF
1622    
1623      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1624           ! Sélection des points pour lesquels le schéma est actif :
1625         ! selection des points pour lesquels le shema est actif:         igwd = 0
1626         igwd=0         DO i = 1, klon
1627         DO i=1, klon            itest(i) = 0
1628            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1629            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1630               itest(i)=1               igwd = igwd + 1
1631               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1632            ENDIF            ENDIF
1633         ENDDO         ENDDO
1634    
# Line 1701  contains Line 1636  contains
1636              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1637              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1638    
1639         ! ajout des tendances         ! Ajout des tendances :
1640         DO k = 1, llm         DO k = 1, llm
1641            DO i = 1, klon            DO i = 1, klon
1642               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 1644  contains
1644               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)
1645            ENDDO            ENDDO
1646         ENDDO         ENDDO
1647        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1648    
1649      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1650    
1651      DO i = 1, klon      DO i = 1, klon
1652         zustrph(i)=0.         zustrph(i) = 0.
1653         zvstrph(i)=0.         zvstrph(i) = 0.
1654      ENDDO      ENDDO
1655      DO k = 1, llm      DO k = 1, llm
1656         DO i = 1, klon         DO i = 1, klon
1657            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* zmasse(i, k)
1658            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)
1659         ENDDO         ENDDO
1660      ENDDO      ENDDO
1661    
1662      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1663             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &  
          aam, torsfc)  
1664    
1665      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1666         ztit='after orography'         ztit = 'after orography'
1667         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1668              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, &
1669              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1758  contains Line 1689  contains
1689    
1690      ! diag. bilKP      ! diag. bilKP
1691    
1692      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, &
1693           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1694    
1695      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1696    
1697      !+jld ec_conser      ! conversion Ec -> E thermique
1698      DO k = 1, llm      DO k = 1, llm
1699         DO i = 1, klon         DO i = 1, klon
1700            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1701            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1702                 *(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)
1703            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)
1704            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1705         END DO         END DO
1706      END DO      END DO
1707      !-jld ec_conser  
1708      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1709         ztit='after physic'         ztit = 'after physic'
1710         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1711              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, &
1712              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1785  contains Line 1716  contains
1716         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1717         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1718              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, &
1719              fs_bound, fq_bound )              fs_bound, fq_bound)
1720    
1721         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1722    
1723      END IF      END IF
1724    
# Line 1805  contains Line 1736  contains
1736    
1737      DO k = 1, llm      DO k = 1, llm
1738         DO i = 1, klon         DO i = 1, klon
1739            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1740            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1741            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1742            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
1743            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
1744         ENDDO         ENDDO
1745      ENDDO      ENDDO
1746    
# Line 1839  contains Line 1770  contains
1770      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1771      IF (lafin) THEN      IF (lafin) THEN
1772         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1773         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1774              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1775              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1776              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1777              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1778      ENDIF      ENDIF
1779    
1780      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1908  contains Line 1837  contains
1837           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1838    
1839           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1840           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)
1841           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1842    
1843           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1844           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)
1845           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1846    
1847           DO i = 1, klon           DO i = 1, klon
1848              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1849           ENDDO           ENDDO
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, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1852    
1853           DO i = 1, klon           DO i = 1, klon
1854              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1855           ENDDO           ENDDO
1856           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)
1857           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1858    
1859           DO i = 1, klon           DO i = 1, klon
1860              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1861           ENDDO           ENDDO
1862           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)
1863           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1864    
1865           DO i = 1, klon           DO i = 1, klon
1866              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1867           ENDDO           ENDDO
1868           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)
1869           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1870    
1871           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)
1872           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1873           !ccIM           !ccIM
1874           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)
1875           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1876    
1877           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)
1878           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1879    
1880           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)
1881           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1882    
1883           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)
1884           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1885    
1886           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)
1887           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1888    
1889           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)
1890           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1891    
1892           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)
1893           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1894    
1895           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)
1896           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1897    
1898           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)
1899           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1900    
1901           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)
1902           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1903    
1904           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)
1905           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1906    
1907           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)
1908           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1909    
1910           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)
1911           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1912    
1913           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1914           ! 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)
1915           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)
1916           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1917    
1918           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)
1919           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1920    
1921           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)
1922           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1923    
1924           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)
1925           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1926    
1927           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)
1928           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1929    
1930           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)
1931           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1932    
1933           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1934              !XXX              !XXX
1935              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1936              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)
1937              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1938                   zx_tmp_2d)                   zx_tmp_2d)
1939    
1940              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1941              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)
1942              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1943                   zx_tmp_2d)                   zx_tmp_2d)
1944    
1945              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1946              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)
1947              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1948                   zx_tmp_2d)                   zx_tmp_2d)
1949    
1950              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1951              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)
1952              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1953                   zx_tmp_2d)                   zx_tmp_2d)
1954    
1955              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1956              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)
1957              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1958                   zx_tmp_2d)                   zx_tmp_2d)
1959    
1960              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1961              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)
1962              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1963                   zx_tmp_2d)                   zx_tmp_2d)
1964    
1965              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1966              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)
1967              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1968                   zx_tmp_2d)                   zx_tmp_2d)
1969    
1970              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1971              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)
1972              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1973                   zx_tmp_2d)                   zx_tmp_2d)
1974    
1975              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1976              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)
1977              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1978                   zx_tmp_2d)                   zx_tmp_2d)
1979    
1980           END DO           END DO
1981           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)
1982           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1983           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)
1984           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1985    
1986           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)
1987           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1988    
          !IM cf. AM 081204 BEG  
   
1989           !HBTM2           !HBTM2
1990    
1991           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)
1992           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1993    
1994           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)
1995           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1996    
1997           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)
1998           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1999    
2000           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)
2001           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
2002    
2003           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)
2004           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
2005    
2006           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)
2007           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
2008    
2009           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)
2010           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
2011    
2012           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)
2013           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
2014    
2015           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)
2016           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
2017    
2018           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)
2019           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2020    
          !IM cf. AM 081204 END  
   
2021           ! Champs 3D:           ! Champs 3D:
2022    
2023           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)
2024           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
2025    
2026           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)
2027           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
2028    
2029           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)
2030           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
2031    
2032           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)
2033           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2034    
2035           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)
2036           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2037    
2038           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)
2039           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2040    
2041           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)
2042           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2043    
2044           if (ok_sync) then           if (ok_sync) then
# Line 2137  contains Line 2062  contains
2062    
2063        ! Champs 3D:        ! Champs 3D:
2064    
2065        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)
2066        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2067    
2068        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)
2069        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2070    
2071        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)
2072        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2073    
2074        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)
2075        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2076    
2077        if (nbtr >= 3) then        if (nbtr >= 3) then
2078           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), &
2079                zx_tmp_3d)                zx_tmp_3d)
2080           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2081        end if        end if
Legend:
Removed from v.47  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.21