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

Diff of /trunk/phylmd/physiq.f

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

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