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

Diff of /trunk/phylmd/physiq.f

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

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