/[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 56 by guez, Tue Jan 10 19:02:02 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 histcom, 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.  
906    
907        ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
908      if (nqmx >= 5) then      if (nqmx >= 5) then
909         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
910      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
911         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
912      ENDIF      ENDIF
913    
914      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
915        DO k = 1, llm
     DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse  
916         DO i = 1, klon         DO i = 1, klon
917            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
918            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
919            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
920            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
921         ENDDO         ENDDO
922      ENDDO      ENDDO
923        ql_seri = 0.
924    
925      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
926         ztit='after reevap'         ztit = 'after reevap'
927         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
928              , 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, &
929              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
930         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
931              , 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, &
932              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
933    
934      END IF      END IF
935    
# Line 1005  contains Line 953  contains
953    
954      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
955      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
956         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
957         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
958      ELSE      ELSE
959         rmu0 = -999.999         rmu0 = -999.999
960      ENDIF      ENDIF
961    
962      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
963      albsol(:)=0.      albsol(:) = 0.
964      albsollw(:)=0.      albsollw(:) = 0.
965      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
966         DO i = 1, klon         DO i = 1, klon
967            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1021  contains Line 969  contains
969         ENDDO         ENDDO
970      ENDDO      ENDDO
971    
972      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
973      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
974    
975      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1034  contains Line 982  contains
982    
983      fder = dlw      fder = dlw
984    
985      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
986           t_seri, q_seri, u_seri, v_seri, &  
987           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
988           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
989           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
990           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
991           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
992           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
993           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
994           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
995           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
996           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
997           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
998           q2, dsens, devap, &      ! Incrémentation des flux
999           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
1000           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
1001           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
1002           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
1003           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
1004      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1005         DO k = 1, llm         DO k = 1, llm
1006            DO i = 1, klon            DO i = 1, klon
1007               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
1008                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1009               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
1010                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1011               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
1012                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1013               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1014                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1015            END DO            END DO
1016         END DO         END DO
1017      END DO      END DO
# Line 1090  contains Line 1031  contains
1031      ENDDO      ENDDO
1032    
1033      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1034         ztit='after clmain'         ztit = 'after clmain'
1035         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1036              , 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, &
1037              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1038         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1039              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1040              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1041      END IF      END IF
1042    
1043      ! Incrementer la temperature du sol      ! Update surface temperature:
1044    
1045      DO i = 1, klon      DO i = 1, klon
1046         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1125  contains Line 1064  contains
1064         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1065         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1066    
1067         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1068              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1069              THEN              THEN
1070            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1071                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1072         ENDIF         ENDIF
1073      ENDDO      ENDDO
# Line 1143  contains Line 1082  contains
1082            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1083            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1084            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1085            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1086                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1087            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1088            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 1101  contains
1101    
1102      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1103         DO i = 1, klon         DO i = 1, klon
1104            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1105    
1106            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1107            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1108            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1109            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1110            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1111            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1112                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1113            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1114            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1115            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1116            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1117            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1118            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1119            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1120            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1121            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1122            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1123         ENDDO         ENDDO
1124      ENDDO      ENDDO
1125    
# Line 1194  contains Line 1133  contains
1133    
1134      DO k = 1, llm      DO k = 1, llm
1135         DO i = 1, klon         DO i = 1, klon
1136            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1137                 + d_q_vdf(i, k)/pdtphys                 + d_q_vdf(i, k)/dtphys
1138            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1139                 + d_t_vdf(i, k)/pdtphys                 + d_t_vdf(i, k)/dtphys
1140         ENDDO         ENDDO
1141      ENDDO      ENDDO
1142      IF (check) THEN      IF (check) THEN
1143         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1144         print *, "avantcon=", za         print *, "avantcon = ", za
1145      ENDIF      ENDIF
1146      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1147      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1148      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1149         DO i = 1, klon         DO i = 1, klon
1150            z_avant(i) = 0.0            z_avant(i) = 0.0
1151         ENDDO         ENDDO
1152         DO k = 1, llm         DO k = 1, llm
1153            DO i = 1, klon            DO i = 1, klon
1154               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &
1155                    *zmasse(i, k)                    *zmasse(i, k)
1156            ENDDO            ENDDO
1157         ENDDO         ENDDO
1158      ENDIF      ENDIF
1159      IF (iflag_con == 1) THEN  
1160         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1161      ELSE IF (iflag_con == 2) THEN      case (1)
1162         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1163              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1164              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1165              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1166              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1167                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1168                pmflxs)
1169         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1170         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1171         DO i = 1, klon         DO i = 1, klon
1172            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1173            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1174         ENDDO         ENDDO
1175      ELSE IF (iflag_con >= 3) THEN      case (3:)
1176         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1177         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1178         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1179         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1180         ntra = 1         ntra = 1
1181         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1182         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1183    
1184         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1185            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &            ! new driver for convectL
1186                 u_seri, v_seri, tr_seri, ntra, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1187                 ema_work1, ema_work2, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1188                 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, &
1189                 rain_con, snow_con, ibas_con, itop_con, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1190                 upwd, dnwd, dnwd0, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1191                 Ma, cape, tvp, iflagctrl, &                 pmflxs, da, phi, mp)
1192                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &            clwcon0 = qcondc
1193                 pmflxr, pmflxs, &            pmfu = upwd + dnwd
1194                 da, phi, mp)         ELSE
1195              ! conema3 ne contient pas les traceurs
1196            clwcon0=qcondc            CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1197            pmfu=upwd+dnwd                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1198         ELSE ! ok_cvl                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1199            ! MAF conema3 ne contient pas les traceurs                 itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &
1200            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1201                 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  
1202    
1203         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1204            do i = 1, klon            do i = 1, klon
1205               wd(i)=0.0               wd(i) = 0.0
1206            enddo            enddo
1207         ENDIF         ENDIF
1208    
1209         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1210    
1211         DO k = 1, llm         DO k = 1, llm
1212            DO i = 1, klon            DO i = 1, klon
1213               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1214               IF (thermcep) THEN               IF (thermcep) THEN
1215                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1216                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1217                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1218                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1219                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1220               ELSE               ELSE
1221                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1222                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1223                  ELSE                  ELSE
1224                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1225                  ENDIF                  ENDIF
1226               ENDIF               ENDIF
1227               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1228            ENDDO            ENDDO
1229         ENDDO         ENDDO
1230    
1231         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1232         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1233         call clouds_gno &         call clouds_gno &
1234              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1235      ELSE      case default
1236         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1237         stop 1         stop 1
1238      ENDIF      END select
1239    
1240      DO k = 1, llm      DO k = 1, llm
1241         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 1247  contains
1247      ENDDO      ENDDO
1248    
1249      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1250         ztit='after convect'         ztit = 'after convect'
1251         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1252              , 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, &
1253              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1254         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1255              , 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, &
1256              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1257      END IF      END IF
1258    
1259      IF (check) THEN      IF (check) THEN
1260         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1261         print *,"aprescon=", za         print *,"aprescon = ", za
1262         zx_t = 0.0         zx_t = 0.0
1263         za = 0.0         za = 0.0
1264         DO i = 1, klon         DO i = 1, klon
# Line 1336  contains Line 1266  contains
1266            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1267                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1268         ENDDO         ENDDO
1269         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1270         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1271      ENDIF      ENDIF
1272      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1273         DO i = 1, klon         DO i = 1, klon
# Line 1345  contains Line 1275  contains
1275         ENDDO         ENDDO
1276         DO k = 1, llm         DO k = 1, llm
1277            DO i = 1, klon            DO i = 1, klon
1278               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &
1279                    *zmasse(i, k)                    *zmasse(i, k)
1280            ENDDO            ENDDO
1281         ENDDO         ENDDO
1282         DO i = 1, klon         DO i = 1, klon
1283            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1284                 /z_apres(i)                 /z_apres(i)
1285         ENDDO         ENDDO
1286         DO k = 1, llm         DO k = 1, llm
1287            DO i = 1, klon            DO i = 1, klon
1288               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1289                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1290               ENDIF               ENDIF
1291            ENDDO            ENDDO
1292         ENDDO         ENDDO
1293      ENDIF      ENDIF
1294      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1295    
1296      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1297    
1298      d_t_ajs=0.      d_t_ajs = 0.
1299      d_u_ajs=0.      d_u_ajs = 0.
1300      d_v_ajs=0.      d_v_ajs = 0.
1301      d_q_ajs=0.      d_q_ajs = 0.
1302      fm_therm=0.      fm_therm = 0.
1303      entr_therm=0.      entr_therm = 0.
1304    
1305      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1306           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1307           , 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)  
1308         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1309         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1310      else      else
1311         !  Thermiques         ! Thermiques
1312         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1313              , 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)  
1314      endif      endif
1315    
1316      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1317         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1318         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1319              , 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, &
1320              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1321      END IF      END IF
1322    
1323      !  Caclul des ratqs      ! Caclul des ratqs
1324    
1325      !   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q
1326      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1327      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1328         do k=1, llm         do k = 1, llm
1329            do i=1, klon            do i = 1, klon
1330               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1331                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1332                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1333               else               else
1334                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1335               endif               endif
1336            enddo            enddo
1337         enddo         enddo
1338      endif      endif
1339    
1340      !   ratqs stables      ! ratqs stables
1341      do k=1, llm      do k = 1, llm
1342         do i=1, klon         do i = 1, klon
1343            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1344                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1345         enddo         enddo
1346      enddo      enddo
1347    
1348      !  ratqs final      ! ratqs final
1349      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1350         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1351         !   ratqs final         ! ratqs final
1352         !   1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1353         !   relaxation des ratqs         ! relaxation des ratqs
1354         facteur=exp(-pdtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1355         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1356         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1357      else      else
1358         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1359         ratqs=ratqss         ratqs = ratqss
1360      endif      endif
1361    
1362      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1363      ! et le processus de precipitation      ! précipitation :
1364      CALL fisrtilp(pdtphys, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1365           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1366           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1367           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1368    
1369      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1370      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1465  contains Line 1379  contains
1379      ENDDO      ENDDO
1380      IF (check) THEN      IF (check) THEN
1381         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1382         print *,"apresilp=", za         print *,"apresilp = ", za
1383         zx_t = 0.0         zx_t = 0.0
1384         za = 0.0         za = 0.0
1385         DO i = 1, klon         DO i = 1, klon
# Line 1473  contains Line 1387  contains
1387            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1388                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1389         ENDDO         ENDDO
1390         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1391         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1392      ENDIF      ENDIF
1393    
1394      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1395         ztit='after fisrt'         ztit = 'after fisrt'
1396         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1397              , 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, &
1398              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1399         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1400              , 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, &
1401              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1402      END IF      END IF
1403    
1404      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1405    
1406      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1407    
1408      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1409         snow_tiedtke=0.         snow_tiedtke = 0.
1410         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1411            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1412         else         else
1413            rain_tiedtke=0.            rain_tiedtke = 0.
1414            do k=1, llm            do k = 1, llm
1415               do i=1, klon               do i = 1, klon
1416                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1417                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1418                          *zmasse(i, k)                          *zmasse(i, k)
1419                  endif                  endif
1420               enddo               enddo
# Line 1510  contains Line 1422  contains
1422         endif         endif
1423    
1424         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1425         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1426              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1427              diafra, dialiq)              diafra, dialiq)
1428         DO k = 1, llm         DO k = 1, llm
1429            DO i = 1, klon            DO i = 1, klon
1430               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1431                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1432                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1433               ENDIF               ENDIF
1434            ENDDO            ENDDO
1435         ENDDO         ENDDO
   
1436      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1437         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1438         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1439         ! facttemps         ! facttemps
1440         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1441         do k=1, llm         do k = 1, llm
1442            do i=1, klon            do i = 1, klon
1443               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1444               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1445                    then                    then
1446                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1447                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1448               endif               endif
1449            enddo            enddo
1450         enddo         enddo
1451    
1452         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1453         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1454         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1455      ENDIF      ENDIF
1456    
1457      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1458    
1459      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1460         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1461         DO k = 1, llm         DO k = 1, llm
1462            DO i = 1, klon            DO i = 1, klon
1463               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1464                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1465                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1466               ENDIF               ENDIF
# Line 1566  contains Line 1476  contains
1476      ENDDO      ENDDO
1477    
1478      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1479         ztit="after diagcld"         ztit = "after diagcld"
1480         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1481              , 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, &
1482              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1483      END IF      END IF
1484    
1485      ! Calculer l'humidite relative pour diagnostique      ! Humidité relative pour diagnostic:
   
1486      DO k = 1, llm      DO k = 1, llm
1487         DO i = 1, klon         DO i = 1, klon
1488            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1489            IF (thermcep) THEN            IF (thermcep) THEN
1490               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1491               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1492               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1493               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1494               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1495            ELSE            ELSE
1496               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1497                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1498               ELSE               ELSE
1499                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1500               ENDIF               ENDIF
1501            ENDIF            ENDIF
1502            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1503            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1504         ENDDO         ENDDO
1505      ENDDO      ENDDO
1506      !jq - introduce the aerosol direct and first indirect radiative forcings  
1507      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1508      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1509        IF (ok_ade .OR. ok_aie) THEN
1510         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1511         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1512         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1513    
1514         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1515         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1516              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1517      ELSE      ELSE
1518         tau_ae(:, :, :)=0.0         tau_ae = 0.
1519         piz_ae(:, :, :)=0.0         piz_ae = 0.
1520         cg_ae(:, :, :)=0.0         cg_ae = 0.
1521      ENDIF      ENDIF
1522    
1523      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour
1524      ! parametres pour diagnostiques:      ! diagnostics :
   
1525      if (ok_newmicro) then      if (ok_newmicro) then
1526         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1527              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1528              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1529              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1530      else      else
1531         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1532              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1533              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1534      endif      endif
1535    
1536      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1537      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1538         DO i = 1, klon         DO i = 1, klon
1539            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1647  contains Line 1546  contains
1546                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1547         ENDDO         ENDDO
1548         ! nouveau rayonnement (compatible Arpege-IFS):         ! nouveau rayonnement (compatible Arpege-IFS):
1549         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1550              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1551              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1552              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1553              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1554              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)  
1555         itaprad = 0         itaprad = 0
1556      ENDIF      ENDIF
1557      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1670  contains Line 1560  contains
1560    
1561      DO k = 1, llm      DO k = 1, llm
1562         DO i = 1, klon         DO i = 1, klon
1563            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * pdtphys/86400.  
1564         ENDDO         ENDDO
1565      ENDDO      ENDDO
1566    
1567      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1568         ztit='after rad'         ztit = 'after rad'
1569         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1570              , 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, &
1571              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1572         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1573              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1574              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1575      END IF      END IF
1576    
1577      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1578      DO i = 1, klon      DO i = 1, klon
1579         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1580         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1700  contains Line 1586  contains
1586         ENDDO         ENDDO
1587      ENDDO      ENDDO
1588    
1589      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1590    
1591      DO i = 1, klon      DO i = 1, klon
1592         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1593      ENDDO      ENDDO
1594    
1595      !mod deb lott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1596    
1597      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1598         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1599         igwd=0         igwd = 0
1600         DO i=1, klon         DO i = 1, klon
1601            itest(i)=0            itest(i) = 0
1602            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1603               itest(i)=1               itest(i) = 1
1604               igwd=igwd+1               igwd = igwd + 1
1605               idx(igwd)=i               idx(igwd) = i
1606            ENDIF            ENDIF
1607         ENDDO         ENDDO
1608    
1609         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1610              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1611              igwd, idx, itest, &              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1612    
1613         !  ajout des tendances         ! ajout des tendances
1614         DO k = 1, llm         DO k = 1, llm
1615            DO i = 1, klon            DO i = 1, klon
1616               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 1621  contains
1621      ENDIF      ENDIF
1622    
1623      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1624           ! Sélection des points pour lesquels le schéma est actif :
1625         !  selection des points pour lesquels le shema est actif:         igwd = 0
1626         igwd=0         DO i = 1, klon
1627         DO i=1, klon            itest(i) = 0
1628            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1629            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1630               itest(i)=1               igwd = igwd + 1
1631               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1632            ENDIF            ENDIF
1633         ENDDO         ENDDO
1634    
1635         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1636              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, &  
1637              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1638    
1639         !  ajout des tendances         ! Ajout des tendances :
1640         DO k = 1, llm         DO k = 1, llm
1641            DO i = 1, klon            DO i = 1, klon
1642               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1767  contains Line 1644  contains
1644               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
1645            ENDDO            ENDDO
1646         ENDDO         ENDDO
1647        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1648    
1649      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1650    
1651      DO i = 1, klon      DO i = 1, klon
1652         zustrph(i)=0.         zustrph(i) = 0.
1653         zvstrph(i)=0.         zvstrph(i) = 0.
1654      ENDDO      ENDDO
1655      DO k = 1, llm      DO k = 1, llm
1656         DO i = 1, klon         DO i = 1, klon
1657            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1658            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)
1659         ENDDO         ENDDO
1660      ENDDO      ENDDO
1661    
1662      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1663             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, gmtime, &  
          ra, rg, romega, &  
          rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
          aam, torsfc)  
1664    
1665      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1666         ztit='after orography'         ztit = 'after orography'
1667         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1668              , 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, &
1669              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1670      END IF      END IF
1671    
1672      ! Calcul  des tendances traceurs      ! Calcul des tendances traceurs
1673      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &
1674           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, &
1675           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1676           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &
1677           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1678           tr_seri, zmasse)           tr_seri, zmasse)
1679    
1680      IF (offline) THEN      IF (offline) THEN
1681         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1682              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1683              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1684      ENDIF      ENDIF
1685    
1686      ! 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 1689  contains
1689    
1690      ! diag. bilKP      ! diag. bilKP
1691    
1692      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, &  
1693           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1694    
1695      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1696    
1697      !+jld ec_conser      ! conversion Ec -> E thermique
1698      DO k = 1, llm      DO k = 1, llm
1699         DO i = 1, klon         DO i = 1, klon
1700            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1701            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1702                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
1703            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
1704            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1705         END DO         END DO
1706      END DO      END DO
1707      !-jld ec_conser  
1708      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1709         ztit='after physic'         ztit = 'after physic'
1710         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1711              , 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, &
1712              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1713         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1714         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1715         !     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.
1716         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1717         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1718              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1719              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1720    
1721         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1722    
1723      END IF      END IF
1724    
1725      !   SORTIES      ! SORTIES
1726    
1727      !cc prw = eau precipitable      !cc prw = eau precipitable
1728      DO i = 1, klon      DO i = 1, klon
# Line 1870  contains Line 1736  contains
1736    
1737      DO k = 1, llm      DO k = 1, llm
1738         DO i = 1, klon         DO i = 1, klon
1739            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1740            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1741            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1742            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1743            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1744         ENDDO         ENDDO
1745      ENDDO      ENDDO
1746    
1747      IF (nqmx >= 3) THEN      IF (nqmx >= 3) THEN
1748         DO iq = 3, nqmx         DO iq = 3, nqmx
1749            DO  k = 1, llm            DO k = 1, llm
1750               DO  i = 1, klon               DO i = 1, klon
1751                  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
1752               ENDDO               ENDDO
1753            ENDDO            ENDDO
1754         ENDDO         ENDDO
# Line 1896  contains Line 1762  contains
1762         ENDDO         ENDDO
1763      ENDDO      ENDDO
1764    
1765      !   Ecriture des sorties      ! Ecriture des sorties
1766      call write_histhf      call write_histhf
1767      call write_histday      call write_histday
1768      call write_histins      call write_histins
# Line 1904  contains Line 1770  contains
1770      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1771      IF (lafin) THEN      IF (lafin) THEN
1772         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1773         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1774              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1775              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1776              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1777              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1778      ENDIF      ENDIF
1779    
1780        firstcal = .FALSE.
1781    
1782    contains    contains
1783    
1784      subroutine write_histday      subroutine write_histday
1785    
1786        use gr_phy_write_3d_m, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1787        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1788    
1789        !------------------------------------------------        !------------------------------------------------
1790    
# Line 1940  contains Line 1806  contains
1806    
1807      subroutine write_histhf      subroutine write_histhf
1808    
1809        ! 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
1810    
1811        !------------------------------------------------        !------------------------------------------------
1812    
# Line 1956  contains Line 1822  contains
1822    
1823      subroutine write_histins      subroutine write_histins
1824    
1825        ! 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
1826    
1827        real zout        real zout
1828        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1829    
1830        !--------------------------------------------------        !--------------------------------------------------
1831    
1832        IF (ok_instan) THEN        IF (ok_instan) THEN
1833           ! Champs 2D:           ! Champs 2D:
1834    
1835           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1836           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1837           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1838    
1839           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1840           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1841           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1842    
1843           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1844           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1845           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1846    
1847           DO i = 1, klon           DO i = 1, klon
1848              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1849           ENDDO           ENDDO
1850           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1851           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1852    
1853           DO i = 1, klon           DO i = 1, klon
1854              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1855           ENDDO           ENDDO
1856           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1857           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1858    
1859           DO i = 1, klon           DO i = 1, klon
1860              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1861           ENDDO           ENDDO
1862           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1863           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1864    
1865           DO i = 1, klon           DO i = 1, klon
1866              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1867           ENDDO           ENDDO
1868           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1869           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1870    
1871           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1872           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1873           !ccIM           !ccIM
1874           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1875           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1876    
1877           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1878           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1879    
1880           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1881           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1882    
1883           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1884           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1885    
1886           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1887           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1888    
1889           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1890           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1891    
1892           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1893           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1894    
1895           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1896           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1897    
1898           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1899           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1900    
1901           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1902           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1903    
1904           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1905           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1906    
1907           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1908           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1909    
1910           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1911           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1912    
1913           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1914           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1915           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1916           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1917    
1918           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1919           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1920    
1921           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1922           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1923    
1924           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1925           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1926    
1927           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1928           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1929    
1930           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1931           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1932    
1933           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1934              !XXX              !XXX
1935              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1936              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1937              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1938                   zx_tmp_2d)                   zx_tmp_2d)
1939    
1940              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1941              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1942              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1943                   zx_tmp_2d)                   zx_tmp_2d)
1944    
1945              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1946              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1947              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1948                   zx_tmp_2d)                   zx_tmp_2d)
1949    
1950              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1951              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1952              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1953                   zx_tmp_2d)                   zx_tmp_2d)
1954    
1955              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1956              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1957              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1958                   zx_tmp_2d)                   zx_tmp_2d)
1959    
1960              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1961              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1962              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1963                   zx_tmp_2d)                   zx_tmp_2d)
1964    
1965              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1966              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1967              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1968                   zx_tmp_2d)                   zx_tmp_2d)
1969    
1970              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1971              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1972              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1973                   zx_tmp_2d)                   zx_tmp_2d)
1974    
1975              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1976              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1977              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1978                   zx_tmp_2d)                   zx_tmp_2d)
1979    
1980           END DO           END DO
1981           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1982           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1983           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1984           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1985    
1986           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1987           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1988    
          !IM cf. AM 081204 BEG  
   
1989           !HBTM2           !HBTM2
1990    
1991           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1992           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1993    
1994           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1995           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1996    
1997           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1998           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1999    
2000           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
2001           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
2002    
2003           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
2004           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
2005    
2006           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
2007           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
2008    
2009           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
2010           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
2011    
2012           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
2013           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
2014    
2015           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
2016           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
2017    
2018           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
2019           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2020    
          !IM cf. AM 081204 END  
   
2021           ! Champs 3D:           ! Champs 3D:
2022    
2023           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
2024           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
2025    
2026           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
2027           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
2028    
2029           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
2030           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
2031    
2032           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
2033           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2034    
2035           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
2036           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2037    
2038           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
2039           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2040    
2041           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
2042           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2043    
2044           if (ok_sync) then           if (ok_sync) then
# Line 2190  contains Line 2052  contains
2052    
2053      subroutine write_histhf3d      subroutine write_histhf3d
2054    
2055        ! 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
2056    
2057        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
2058    
2059        !-------------------------------------------------------        !-------------------------------------------------------
2060    
# Line 2200  contains Line 2062  contains
2062    
2063        ! Champs 3D:        ! Champs 3D:
2064    
2065        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
2066        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2067    
2068        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)
2069        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2070    
2071        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
2072        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2073    
2074        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
2075        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2076    
2077        if (nbtr >= 3) then        if (nbtr >= 3) then
2078           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), &
2079                zx_tmp_3d)                zx_tmp_3d)
2080           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2081        end if        end if

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

  ViewVC Help
Powered by ViewVC 1.1.21