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