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

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

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

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

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

  ViewVC Help
Powered by ViewVC 1.1.21