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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/phylmd/physiq.f revision 92 by guez, Wed Mar 26 18:16:05 2014 UTC
# Line 5  module physiq_m Line 5  module physiq_m
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)
9    
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11        ! (subversion revision 678)
12    
     ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)  
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
17        use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      USE calendar, ONLY: ymds2ju      use aeropt_m, only: aeropt
20        use ajsec_m, only: ajsec
21      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf, soil_model
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27        use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32        use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
35      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
36      USE dimens_m, ONLY: iim, jjm, llm, nqmx      use diagphy_m, only: diagphy
37        USE dimens_m, ONLY: llm, nqmx
38      USE dimphy, ONLY: klon, nbtr      USE dimphy, ONLY: klon, nbtr
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
40      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
41      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
42        use fisrtilp_m, only: fisrtilp
43      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histcom, ONLY: histsync  
     USE histwrite_m, ONLY: histwrite  
44      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45           nbsrf           nbsrf
     USE ini_histhf_m, ONLY: ini_histhf  
     USE ini_histday_m, ONLY: ini_histday  
46      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
47        use newmicro_m, only: newmicro
48      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
49      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite, zenang
50      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 48  contains Line 53  contains
53      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
54      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
55      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
56        use radlwsw_m, only: radlwsw
57        use readsulfate_m, only: readsulfate
58        use sugwd_m, only: sugwd
59      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
60      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
61        use unit_nml_m, only: unit_nml
62        USE ymds2ju_m, ONLY: ymds2ju
63      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      ! Arguments:      logical, intent(in):: lafin ! dernier passage
66    
67      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
68      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
69    
70      REAL, intent(in):: time ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
71      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     logical, intent(in):: lafin ! dernier passage  
72    
73      REAL, intent(in):: paprs(klon, llm + 1)      REAL, intent(in):: paprs(klon, llm + 1)
74      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
# Line 79  contains Line 88  contains
88      REAL, intent(in):: t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
89    
90      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
91      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
92    
93      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL, intent(in):: omega(klon, llm) ! vitesse verticale en Pa/s
94      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m s-2)
95      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m s-2)
96      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
97      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)      REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1)
98      REAL d_ps(klon) ! output tendance physique de la pression au sol  
99        ! Local:
100    
101      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta = 3)      PARAMETER(nbteta = 3)
105    
     REAL PVteta(klon, nbteta)  
     ! (output vorticite potentielle a des thetas constantes)  
   
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl = .TRUE.)  
106      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
107      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
108    
# Line 112  contains Line 117  contains
117      logical rnpb      logical rnpb
118      parameter(rnpb = .true.)      parameter(rnpb = .true.)
119    
120      character(len = 6), save:: ocean      character(len = 6):: ocean = 'force '
121      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais
122        ! pas "couple")
     logical ok_ocean  
     SAVE ok_ocean  
123    
124      ! "slab" ocean      ! "slab" ocean
125      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
# Line 125  contains Line 128  contains
128      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
129    
130      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
131      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
132    
133      LOGICAL ok_mensuel ! sortir le fichier mensuel      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
134        ! sorties journalieres, mensuelles et instantanees dans les
135      LOGICAL ok_instan ! sortir le fichier instantane      ! fichiers histday, histmth et histins
     save ok_instan  
136    
137      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
138      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 154  contains Line 155  contains
155    
156      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
157    
158      !IM Amip2 PV a theta constante      ! Amip2 PV a theta constante
159    
160      CHARACTER(LEN = 3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
161      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
162      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
163      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
164    
165      !MI Amip2 PV a theta constante      ! Amip2 PV a theta constante
   
     INTEGER klevp1  
     PARAMETER(klevp1 = llm + 1)  
166    
167      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
168      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
169      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
170    
171      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
172      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
173      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
174    
175      !IM Amip2      ! Amip2
176      ! variables a une pression donnee      ! variables a une pression donnee
177    
178      integer nlevSTD      integer nlevSTD
# Line 202  contains Line 200  contains
200      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
201    
202      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
203      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
204      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
205    
206      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 243  contains Line 241  contains
241           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
242           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
243    
244      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
245    
246      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
247      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
# Line 264  contains Line 262  contains
262      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
263      ! soil temperature of surface fraction      ! soil temperature of surface fraction
264    
265      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
266      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
267      SAVE fluxlat      SAVE fluxlat
268    
# Line 282  contains Line 279  contains
279      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
280      SAVE falblw ! albedo par type de surface      SAVE falblw ! albedo par type de surface
281    
282      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
283      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
284      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
285      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 312  contains Line 309  contains
309      SAVE Ma      SAVE Ma
310      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
311      SAVE qcondc      SAVE qcondc
312      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
313      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
314    
315      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
316    
# Line 325  contains Line 319  contains
319      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
320      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
321    
322      !AA Pour phytrac      ! Pour phytrac :
323      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
324      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
325      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 344  contains Line 338  contains
338      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
339      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
340    
341      !AA      REAL, save:: rain_fall(klon) ! pluie
342      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
343      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
344      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
345    
346      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
347      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
348      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
349      SAVE dlw      SAVE dlw
# Line 372  contains Line 364  contains
364      INTEGER julien      INTEGER julien
365    
366      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
367      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
368      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
369    
     SAVE pctsrf ! sous-fraction du sol  
370      REAL albsol(klon)      REAL albsol(klon)
371      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
372      REAL albsollw(klon)      REAL albsollw(klon)
# Line 387  contains Line 377  contains
377      ! Declaration des procedures appelees      ! Declaration des procedures appelees
378    
379      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec ! ajustement sec  
380      !KE43      !KE43
381      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
382      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
383      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
384    
385      ! Variables locales      ! Variables locales
386    
387      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
388      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
389    
390      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
391      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 420  contains Line 405  contains
405      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
406      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
407    
408      REAL heat(klon, llm) ! chauffage solaire      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
409        ! les variables soient r\'emanentes.
410        REAL, save:: heat(klon, llm) ! chauffage solaire
411      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
412      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
413      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
414      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
415      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
416      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      real, save:: sollwdown(klon) ! downward LW flux at surface
417        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
418      REAL albpla(klon)      REAL albpla(klon)
419      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
420      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
421      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla
422      ! sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
423    
424      INTEGER itaprad      INTEGER itaprad
425      SAVE itaprad      SAVE itaprad
# Line 449  contains Line 435  contains
435      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
436      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
437      real zlongi      real zlongi
   
438      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
439      REAL za, zb      REAL za, zb
440      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
441      real zqsat(klon, llm)      real zqsat(klon, llm)
442      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
443      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
444      REAL zphi(klon, llm)      REAL zphi(klon, llm)
445    
446      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
447    
448      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
449      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 480  contains Line 461  contains
461      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
462      REAL s_trmb3(klon)      REAL s_trmb3(klon)
463    
464      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
465    
466      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
467      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 496  contains Line 477  contains
477      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
478      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
479      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
480      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
481      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
482    
# Line 505  contains Line 485  contains
485      ! con: convection      ! con: convection
486      ! lsc: large scale condensation      ! lsc: large scale condensation
487      ! ajs: ajustement sec      ! ajs: ajustement sec
488      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
489      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
490      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
491      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 514  contains Line 494  contains
494      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
495      REAL rneb(klon, llm)      REAL rneb(klon, llm)
496    
497      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
498      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
499      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
500      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
501      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
502      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
503    
504      INTEGER,save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
505    
506      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
507      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 535  contains Line 515  contains
515      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
516      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
517    
518      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
519      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
520      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
521    
522      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
523      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
524      real, save:: facttemps      real:: facttemps = 1.e-4
525      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
526      real facteur      real facteur
527    
528      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
529      logical ptconv(klon, llm)      logical ptconv(klon, llm)
530    
531      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
532    
533      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
534      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 567  contains Line 544  contains
544      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
545      REAL aam, torsfc      REAL aam, torsfc
546    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
547      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
548    
549      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
550    
# Line 580  contains Line 554  contains
554      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
555    
556      REAL zsto      REAL zsto
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
557      real date0      real date0
558    
559      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
560      REAL ztsol(klon)      REAL ztsol(klon)
561      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
562      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
563      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
564      REAL zero_v(klon)      REAL zero_v(klon)
565      CHARACTER(LEN = 15) ztit      CHARACTER(LEN = 15) tit
566      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
567      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
568    
569      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
570      REAL ZRCPD      REAL ZRCPD
571    
572      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
573      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
574      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
575      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
576      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
577      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
578    
579        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
580    
581      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
582      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
583    
584      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
585      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
586    
587      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
588      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
589    
590      ! Aerosol optical properties      ! Aerosol optical properties
591      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
592      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
593    
594      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
595      ! 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  
596    
597      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
598    
599      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
600      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
601      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
602        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
603        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
604        ! B). They link cloud droplet number concentration to aerosol mass
605        ! concentration.
606    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
607      SAVE u10m      SAVE u10m
608      SAVE v10m      SAVE v10m
609      SAVE t2m      SAVE t2m
610      SAVE q2m      SAVE q2m
611      SAVE ffonte      SAVE ffonte
612      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
613      SAVE rain_con      SAVE rain_con
614      SAVE snow_con      SAVE snow_con
615      SAVE topswai      SAVE topswai
# Line 651  contains Line 618  contains
618      SAVE solswad      SAVE solswad
619      SAVE d_u_con      SAVE d_u_con
620      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
621    
622      real zmasse(klon, llm)      real zmasse(klon, llm)
623      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
624    
625      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
626    
627        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
628             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
629             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
630             nsplit_thermals
631    
632      !----------------------------------------------------------------      !----------------------------------------------------------------
633    
634      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
635      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
636         DO i = 1, klon           'eaux vapeur et liquide sont indispensables', 1)
           zero_v(i) = 0.  
        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  
637    
638      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
639         ! initialiser         ! initialiser
# Line 686  contains Line 648  contains
648         cg_ae = 0.         cg_ae = 0.
649         rain_con(:) = 0.         rain_con(:) = 0.
650         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
651         topswai(:) = 0.         topswai(:) = 0.
652         topswad(:) = 0.         topswad(:) = 0.
653         solswai(:) = 0.         solswai(:) = 0.
654         solswad(:) = 0.         solswad(:) = 0.
655    
656         d_u_con = 0.0         d_u_con = 0.
657         d_v_con = 0.0         d_v_con = 0.
658         rnebcon0 = 0.0         rnebcon0 = 0.
659         clwcon0 = 0.0         clwcon0 = 0.
660         rnebcon = 0.0         rnebcon = 0.
661         clwcon = 0.0         clwcon = 0.
662    
663         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
664         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 713  contains Line 673  contains
673    
674         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
675    
676         ! appel a la lecture du run.def physique         iflag_thermals = 0
677           nsplit_thermals = 1
678           print *, "Enter namelist 'physiq_nml'."
679           read(unit=*, nml=physiq_nml)
680           write(unit_nml, nml=physiq_nml)
681    
682         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)  
683    
684         ! Initialiser les compteurs:         ! Initialiser les compteurs:
685    
# Line 729  contains Line 688  contains
688         itaprad = 0         itaprad = 0
689         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
690              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
691              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
692              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
693              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
694    
695         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
696         q2 = 1.e-8         q2 = 1e-8
697    
698         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
699    
# Line 742  contains Line 701  contains
701         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
702    
703         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
704           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
705                ok_instan, ok_region)
706    
707         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
708            ok_ocean = .TRUE.            print *, "Au minimum 4 appels par jour si cycle diurne"
709         ENDIF            call abort_gcm('physiq', &
710                   "Nombre d'appels au rayonnement insuffisant", 1)
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 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)  
711         ENDIF         ENDIF
        print *,"Clef pour la convection, iflag_con = ", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl = ", &  
             ok_cvl  
712    
713         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
714         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
715              ibas_con = 1
716            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  
   
717         ENDIF         ENDIF
718    
719         IF (ok_orodr) THEN         IF (ok_orodr) THEN
720            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
721            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
722         else         else
723            rugoro = 0.            rugoro = 0.
724         ENDIF         ENDIF
# Line 795  contains Line 737  contains
737         npas = 0         npas = 0
738         nexca = 0         nexca = 0
739    
        print *,'AVANT HIST IFLAG_CON = ', iflag_con  
   
740         ! Initialisation des sorties         ! Initialisation des sorties
741    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
742         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
743         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
744         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
745         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
746      ENDIF test_firstcal      ENDIF test_firstcal
747    
748      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
   
     DO i = 1, klon  
        d_ps(i) = 0.0  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
749      da = 0.      da = 0.
750      mp = 0.      mp = 0.
751      phi = 0.      phi = 0.
752    
753      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ! We will modify variables *_seri and we will not touch variables
754        ! u, v, h, q:
755      DO k = 1, llm      DO k = 1, llm
756         DO i = 1, klon         DO i = 1, klon
757            t_seri(i, k) = t(i, k)            t_seri(i, k) = t(i, k)
# Line 851  contains Line 778  contains
778      ENDDO      ENDDO
779    
780      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
781         ztit = 'after dynamics'         tit = 'after dynamics'
782         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, &
783              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, &
784              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
785         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajout\'es dans la
786         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
787         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
788         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
789         !  nulle.         !  nulle.
790         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, &
791              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
792              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
793      END IF      END IF
# Line 876  contains Line 803  contains
803      ELSE      ELSE
804         DO k = 1, llm         DO k = 1, llm
805            DO i = 1, klon            DO i = 1, klon
806               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
807               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
808            ENDDO            ENDDO
809         ENDDO         ENDDO
810         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 900  contains Line 827  contains
827    
828      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
829    
830      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
831    
832      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
833      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  
834    
835      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
836      DO k = 1, llm      DO k = 1, llm
837         DO i = 1, klon         DO i = 1, klon
838            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 921  contains Line 844  contains
844      ql_seri = 0.      ql_seri = 0.
845    
846      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
847         ztit = 'after reevap'         tit = 'after reevap'
848         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, &
849              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, &
850              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
851         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, &
852              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, &
853              fs_bound, fq_bound)              fs_bound, fq_bound)
854    
# Line 934  contains Line 857  contains
857      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
858    
859      DO i = 1, klon      DO i = 1, klon
860         zxrugs(i) = 0.0         zxrugs(i) = 0.
861      ENDDO      ENDDO
862      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
863         DO i = 1, klon         DO i = 1, klon
# Line 967  contains Line 890  contains
890         ENDDO         ENDDO
891      ENDDO      ENDDO
892    
893      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
894      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
895    
896      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
897         DO i = 1, klon         DO i = 1, klon
898            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
899                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
900            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
901         ENDDO         ENDDO
902      ENDDO      ENDDO
903    
# Line 982  contains Line 905  contains
905    
906      ! Couche limite:      ! Couche limite:
907    
908      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
909           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
910           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
911           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
912           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
913           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
914           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
915           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
916           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
917           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
918    
919      ! Incrémentation des flux      ! Incr\'ementation des flux
920    
921      zxfluxt = 0.      zxfluxt = 0.
922      zxfluxq = 0.      zxfluxq = 0.
# Line 1002  contains Line 925  contains
925      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
926         DO k = 1, llm         DO k = 1, llm
927            DO i = 1, klon            DO i = 1, klon
928               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
929                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
930               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
931                    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)  
932            END DO            END DO
933         END DO         END DO
934      END DO      END DO
935      DO i = 1, klon      DO i = 1, klon
936         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
937         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
938         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
939      ENDDO      ENDDO
940    
# Line 1029  contains Line 948  contains
948      ENDDO      ENDDO
949    
950      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
951         ztit = 'after clmain'         tit = 'after clmain'
952         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, &
953              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, &
954              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
955         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, &
956              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, &
957              fs_bound, fq_bound)              fs_bound, fq_bound)
958      END IF      END IF
# Line 1041  contains Line 960  contains
960      ! Update surface temperature:      ! Update surface temperature:
961    
962      DO i = 1, klon      DO i = 1, klon
963         zxtsol(i) = 0.0         zxtsol(i) = 0.
964         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
965    
966         zt2m(i) = 0.0         zt2m(i) = 0.
967         zq2m(i) = 0.0         zq2m(i) = 0.
968         zu10m(i) = 0.0         zu10m(i) = 0.
969         zv10m(i) = 0.0         zv10m(i) = 0.
970         zxffonte(i) = 0.0         zxffonte(i) = 0.
971         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
972    
973         s_pblh(i) = 0.0         s_pblh(i) = 0.
974         s_lcl(i) = 0.0         s_lcl(i) = 0.
975         s_capCL(i) = 0.0         s_capCL(i) = 0.
976         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
977         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
978         s_pblT(i) = 0.0         s_pblT(i) = 0.
979         s_therm(i) = 0.0         s_therm(i) = 0.
980         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
981         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
982         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
983    
984         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
985              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
986              THEN              'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i, &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
987      ENDDO      ENDDO
988      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
989         DO i = 1, klon         DO i = 1, klon
# Line 1124  contains Line 1040  contains
1040      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1041    
1042      DO i = 1, klon      DO i = 1, klon
1043         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1044      ENDDO      ENDDO
1045    
1046      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1047    
1048      DO k = 1, llm      DO k = 1, llm
1049         DO i = 1, klon         DO i = 1, klon
1050            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1051                 + 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  
1052         ENDDO         ENDDO
1053      ENDDO      ENDDO
1054    
1055      IF (check) THEN      IF (check) THEN
1056         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1057         print *, "avantcon = ", za         print *, "avantcon = ", za
1058      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
     IF (iflag_con == 2) zx_ajustq = .TRUE.  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
1059    
1060      select case (iflag_con)      if (iflag_con == 2) then
1061      case (1)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1062         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1063         stop 1              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1064      case (2)              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1065         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1066              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              kdtop, pmflxr, pmflxs)
             pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &  
             pmflxs)  
1067         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1068         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1069         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1070            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1071            itop_con(i) = llm + 1 - kctop(i)      else
1072         ENDDO         ! iflag_con >= 3
1073      case (3:)  
1074         ! number of tracers for the convection scheme of Kerry Emanuel:         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1075                v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1076                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1077                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1078                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1079                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1080           ! (number of tracers for the convection scheme of Kerry Emanuel:
1081         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1082         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1083         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.)
        ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        IF (ok_cvl) THEN  
           ! new driver for convectL  
           CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &  
                d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &  
                bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &  
                pmflxs, da, phi, mp)  
           clwcon0 = qcondc  
           pmfu = upwd + dnwd  
        ELSE  
           ! 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  
1084    
1085         IF (.NOT. ok_gust) THEN         clwcon0 = qcondc
1086            do i = 1, klon         mfu = upwd + dnwd
1087               wd(i) = 0.0         IF (.NOT. ok_gust) wd = 0.
           enddo  
        ENDIF  
1088    
1089         ! Calcul des propriétés des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1090    
1091         DO k = 1, llm         DO k = 1, llm
1092            DO i = 1, klon            DO i = 1, klon
1093               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1094               IF (thermcep) THEN               IF (thermcep) THEN
1095                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1096                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1097                  zx_qs = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1098                  zcor = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1099                  zx_qs = zx_qs*zcor                  zx_qs = zx_qs*zcor
# Line 1227  contains Line 1109  contains
1109         ENDDO         ENDDO
1110    
1111         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1112         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1113         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1114              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1115      case default  
1116         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1117         stop 1         pen_u = 0.
1118      END select         pen_d = 0.
1119           pde_d = 0.
1120           pde_u = 0.
1121        END if
1122    
1123      DO k = 1, llm      DO k = 1, llm
1124         DO i = 1, klon         DO i = 1, klon
# Line 1245  contains Line 1130  contains
1130      ENDDO      ENDDO
1131    
1132      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1133         ztit = 'after convect'         tit = 'after convect'
1134         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, &
1135              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, &
1136              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1137         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, &
1138              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, &
1139              fs_bound, fq_bound)              fs_bound, fq_bound)
1140      END IF      END IF
1141    
1142      IF (check) THEN      IF (check) THEN
1143         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1144         print *,"aprescon = ", za         print *, "aprescon = ", za
1145         zx_t = 0.0         zx_t = 0.
1146         za = 0.0         za = 0.
1147         DO i = 1, klon         DO i = 1, klon
1148            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1149            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1150                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1151         ENDDO         ENDDO
1152         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1153         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1154      ENDIF      ENDIF
1155      IF (zx_ajustq) THEN  
1156         DO i = 1, klon      IF (iflag_con == 2) THEN
1157            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1158         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  
1159         DO k = 1, llm         DO k = 1, llm
1160            DO i = 1, klon            DO i = 1, klon
1161               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
# Line 1289  contains Line 1164  contains
1164            ENDDO            ENDDO
1165         ENDDO         ENDDO
1166      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1167    
1168      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1169    
1170      d_t_ajs = 0.      d_t_ajs = 0.
1171      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1312  contains Line 1186  contains
1186      endif      endif
1187    
1188      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1189         ztit = 'after dry_adjust'         tit = 'after dry_adjust'
1190         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, &
1191              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, &
1192              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1193      END IF      END IF
1194    
1195      ! Caclul des ratqs      ! Caclul des ratqs
1196    
1197      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
1198      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1199      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1200         do k = 1, llm         do k = 1, llm
1201            do i = 1, klon            do i = 1, klon
1202               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1203                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1204                       +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)
1205               else               else
1206                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1207               endif               endif
# Line 1338  contains Line 1212  contains
1212      ! ratqs stables      ! ratqs stables
1213      do k = 1, llm      do k = 1, llm
1214         do i = 1, klon         do i = 1, klon
1215            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1216                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1217         enddo         enddo
1218      enddo      enddo
1219    
1220      ! ratqs final      ! ratqs final
1221      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1222         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1223         ! ratqs final         ! ratqs final
1224         ! 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
1225         ! relaxation des ratqs         ! relaxation des ratqs
1226         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1227         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1228      else      else
1229         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1230         ratqs = ratqss         ratqs = ratqss
1231      endif      endif
1232    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1233      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1234           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1235           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1377  contains Line 1248  contains
1248      ENDDO      ENDDO
1249      IF (check) THEN      IF (check) THEN
1250         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1251         print *,"apresilp = ", za         print *, "apresilp = ", za
1252         zx_t = 0.0         zx_t = 0.
1253         za = 0.0         za = 0.
1254         DO i = 1, klon         DO i = 1, klon
1255            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1256            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1257                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1258         ENDDO         ENDDO
1259         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1260         print *,"Precip = ", zx_t         print *, "Precip = ", zx_t
1261      ENDIF      ENDIF
1262    
1263      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1264         ztit = 'after fisrt'         tit = 'after fisrt'
1265         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, &
1266              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, &
1267              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1268         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, &
1269              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, &
1270              fs_bound, fq_bound)              fs_bound, fq_bound)
1271      END IF      END IF
# Line 1403  contains Line 1274  contains
1274    
1275      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1276    
1277      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1278           ! seulement pour Tiedtke
1279         snow_tiedtke = 0.         snow_tiedtke = 0.
1280         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1281            rain_tiedtke = rain_con            rain_tiedtke = rain_con
# Line 1420  contains Line 1292  contains
1292         endif         endif
1293    
1294         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1295         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1296              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1297         DO k = 1, llm         DO k = 1, llm
1298            DO i = 1, klon            DO i = 1, klon
1299               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1432  contains Line 1303  contains
1303            ENDDO            ENDDO
1304         ENDDO         ENDDO
1305      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1306         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1307         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1308         ! facttemps         ! d'un facteur facttemps.
1309         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1310         do k = 1, llm         do k = 1, llm
1311            do i = 1, klon            do i = 1, klon
1312               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1313               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1314                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1315                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1316                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1317               endif               endif
# Line 1467  contains Line 1338  contains
1338      ENDIF      ENDIF
1339    
1340      ! Precipitation totale      ! Precipitation totale
   
1341      DO i = 1, klon      DO i = 1, klon
1342         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1343         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1344      ENDDO      ENDDO
1345    
1346      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1347         ztit = "after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1348         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  
1349    
1350      ! Humidité relative pour diagnostic:      ! Humidit\'e relative pour diagnostic :
1351      DO k = 1, llm      DO k = 1, llm
1352         DO i = 1, klon         DO i = 1, klon
1353            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1503  contains Line 1370  contains
1370      ENDDO      ENDDO
1371    
1372      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)  
1373      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1374         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1375         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1376         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1377    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1378         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1379              aerindex)              aerindex)
1380      ELSE      ELSE
# Line 1518  contains Line 1383  contains
1383         cg_ae = 0.         cg_ae = 0.
1384      ENDIF      ENDIF
1385    
1386      ! Paramètres optiques des nuages et quelques paramètres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics :
     ! diagnostics :  
1387      if (ok_newmicro) then      if (ok_newmicro) then
1388         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1389              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1390              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1391      else      else
1392         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1393              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
# Line 1543  contains Line 1406  contains
1406                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1407                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1408         ENDDO         ENDDO
1409         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1410         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1411              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1412              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1563  contains Line 1426  contains
1426      ENDDO      ENDDO
1427    
1428      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1429         ztit = 'after rad'         tit = 'after rad'
1430         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, &
1431              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, &
1432              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1433         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1434              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, &
1435              fs_bound, fq_bound)              fs_bound, fq_bound)
1436      END IF      END IF
1437    
1438      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1439      DO i = 1, klon      DO i = 1, klon
1440         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1441         zxsnow(i) = 0.0         zxsnow(i) = 0.
1442      ENDDO      ENDDO
1443      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1444         DO i = 1, klon         DO i = 1, klon
# Line 1584  contains Line 1447  contains
1447         ENDDO         ENDDO
1448      ENDDO      ENDDO
1449    
1450      ! Calculer le bilan du sol et la dérive de température (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1451    
1452      DO i = 1, klon      DO i = 1, klon
1453         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1454      ENDDO      ENDDO
1455    
1456      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1457    
1458      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1459         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1460         igwd = 0         igwd = 0
1461         DO i = 1, klon         DO i = 1, klon
1462            itest(i) = 0            itest(i) = 0
1463            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1464               itest(i) = 1               itest(i) = 1
1465               igwd = igwd + 1               igwd = igwd + 1
1466               idx(igwd) = i               idx(igwd) = i
# Line 1619  contains Line 1482  contains
1482      ENDIF      ENDIF
1483    
1484      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1485         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1486         igwd = 0         igwd = 0
1487         DO i = 1, klon         DO i = 1, klon
1488            itest(i) = 0            itest(i) = 0
# Line 1644  contains Line 1507  contains
1507         ENDDO         ENDDO
1508      ENDIF      ENDIF
1509    
1510      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
1511    
1512      DO i = 1, klon      DO i = 1, klon
1513         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1652  contains Line 1515  contains
1515      ENDDO      ENDDO
1516      DO k = 1, llm      DO k = 1, llm
1517         DO i = 1, klon         DO i = 1, klon
1518            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 &
1519            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1520              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1521                   * zmasse(i, k)
1522         ENDDO         ENDDO
1523      ENDDO      ENDDO
1524    
1525      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1526             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &  
          aam, torsfc)  
1527    
1528      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1529         ztit = 'after orography'           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1530         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  
1531    
1532      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1533      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1534           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1535           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1536           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1537           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1538           tr_seri, zmasse)  
1539        IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1540      IF (offline) THEN           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1541         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1542    
1543      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1544      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1707  contains Line 1563  contains
1563      END DO      END DO
1564    
1565      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1566         ztit = 'after physic'         tit = 'after physic'
1567         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, &
1568              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, &
1569              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1570         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1571         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1572         ! 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.
1573         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1574         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1575              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, &
1576              fs_bound, fq_bound)              fs_bound, fq_bound)
1577    
# Line 1725  contains Line 1581  contains
1581    
1582      ! SORTIES      ! SORTIES
1583    
1584      !cc prw = eau precipitable      ! prw = eau precipitable
1585      DO i = 1, klon      DO i = 1, klon
1586         prw(i) = 0.         prw(i) = 0.
1587         DO k = 1, llm         DO k = 1, llm
# Line 1764  contains Line 1620  contains
1620      ENDDO      ENDDO
1621    
1622      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1623      call write_histins      call write_histins
1624    
1625      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
# Line 1773  contains Line 1627  contains
1627         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1628         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1629              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1630              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1631              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1632              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1633      ENDIF      ENDIF
1634    
1635      firstcal = .FALSE.      firstcal = .FALSE.
1636    
1637    contains    contains
1638    
     subroutine write_histday  
   
       use gr_phy_write_3d_m, only: gr_phy_write_3d  
       integer itau_w ! pas de temps ecriture  
   
       !------------------------------------------------  
   
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
   
1639      subroutine write_histins      subroutine write_histins
1640    
1641        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1642    
1643          use dimens_m, only: iim, jjm
1644          USE histsync_m, ONLY: histsync
1645          USE histwrite_m, ONLY: histwrite
1646    
1647        real zout        real zout
1648        integer itau_w ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1649          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1650    
1651        !--------------------------------------------------        !--------------------------------------------------
1652    
# Line 2042  contains Line 1862  contains
1862           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)
1863           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1864    
1865           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1866        ENDIF        ENDIF
1867    
1868      end subroutine write_histins      end subroutine write_histins
1869    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09  
   
       integer itau_w ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1870    END SUBROUTINE physiq    END SUBROUTINE physiq
1871    
1872  end module physiq_m  end module physiq_m
Legend:
Removed from v.52  
changed lines
  Added in v.92
  ViewVC Help
Powered by ViewVC 1.1.21