/[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 68 by guez, Wed Nov 14 16:59:30 2012 UTC trunk/phylmd/physiq.f revision 97 by guez, Fri Apr 25 14:58:31 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.
# Line 16  contains Line 18  contains
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19      use aeropt_m, only: aeropt      use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
     USE calendar, ONLY: ymds2ju  
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
# Line 32  contains Line 34  contains
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
35      use diagetpq_m, only: diagetpq      use diagetpq_m, only: diagetpq
36      use diagphy_m, only: diagphy      use diagphy_m, only: diagphy
37      USE dimens_m, ONLY: iim, jjm, llm, nqmx      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      use fisrtilp_m, only: fisrtilp
43      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
     USE histsync_m, 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      use newmicro_m, only: newmicro
48      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
# Line 56  contains Line 54  contains
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      use radlwsw_m, only: radlwsw
57        use readsulfate_m, only: readsulfate
58      use sugwd_m, only: sugwd      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      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 78  contains Line 77  contains
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
78    
79      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
80      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! géopotentiel de chaque couche (référence sol)
81    
82      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! géopotentiel du sol
83    
84      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
85      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
# Line 89  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)  
   
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 121  contains Line 118  contains
118      parameter(rnpb = .true.)      parameter(rnpb = .true.)
119    
120      character(len = 6):: ocean = 'force '      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 160  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 208  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 249  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
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
245    
246      ! Variables propres a la physique      ! Variables propres a la physique
247    
# Line 270  contains Line 259  contains
259      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
260      ! soil temperature of surface fraction      ! soil temperature of surface fraction
261    
262      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
263      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
264      SAVE fluxlat      SAVE fluxlat
265    
# Line 288  contains Line 276  contains
276      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
277      SAVE falblw ! albedo par type de surface      SAVE falblw ! albedo par type de surface
278    
279      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
280      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
281      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
282      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 310  contains Line 298  contains
298      !KE43      !KE43
299      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
300    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
301      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
302      SAVE Ma      SAVE Ma
303      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
304      SAVE qcondc      SAVE qcondc
305      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
306      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
307    
308      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
309    
# Line 331  contains Line 312  contains
312      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
313      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
314    
315      !AA Pour phytrac      ! Pour phytrac :
316      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
317      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
318      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 355  contains Line 336  contains
336    
337      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
338    
339      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
340      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
341      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
342      SAVE dlw      SAVE dlw
# Line 376  contains Line 357  contains
357      INTEGER julien      INTEGER julien
358    
359      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
360      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
361      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
362    
     SAVE pctsrf ! sous-fraction du sol  
363      REAL albsol(klon)      REAL albsol(klon)
364      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
365      REAL albsollw(klon)      REAL albsollw(klon)
# Line 390  contains Line 369  contains
369    
370      ! Declaration des procedures appelees      ! Declaration des procedures appelees
371    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
372      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
373      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
374    
375      ! Variables locales      ! Variables locales
376    
377      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
378      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
379    
380      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
381      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 421  contains Line 395  contains
395      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
396      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
397    
398      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
399      ! les variables soient rémanentes.      ! les variables soient r\'emanentes.
400      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
401      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
402      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
403      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
404      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
405      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
406        real, save:: sollwdown(klon) ! downward LW flux at surface
407      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
408      REAL albpla(klon)      REAL albpla(klon)
409      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
410      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
411      SAVE albpla, sollwdown      SAVE albpla
412      SAVE heat0, cool0      SAVE heat0, cool0
413    
414      INTEGER itaprad      INTEGER itaprad
# Line 450  contains Line 425  contains
425      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
426      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
427      real zlongi      real zlongi
   
428      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
429      REAL za, zb      REAL za, zb
430      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
431      real zqsat(klon, llm)      real zqsat(klon, llm)
432      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
433      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
434      REAL zphi(klon, llm)      REAL zphi(klon, llm)
435    
436      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
437    
438      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
439      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 486  contains Line 456  contains
456      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
457      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
458      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
     REAL tvp(klon, llm) ! virtual temp of lifted parcel  
459      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
460      SAVE cape      SAVE cape
461    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
462      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     INTEGER ntra ! nb traceurs pour convect4.3  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
463    
464      ! Variables du changement      ! Variables du changement
465    
466      ! con: convection      ! con: convection
467      ! lsc: large scale condensation      ! lsc: large scale condensation
468      ! ajs: ajustement sec      ! ajs: ajustement sec
469      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
470      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
471      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
472      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
# Line 515  contains Line 475  contains
475      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
476      REAL rneb(klon, llm)      REAL rneb(klon, llm)
477    
478      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
479      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
480      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
481      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
# Line 549  contains Line 509  contains
509      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
510      logical ptconv(klon, llm)      logical ptconv(klon, llm)
511    
512      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en s\'erie :
513    
514      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
515      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
516      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
   
517      REAL tr_seri(klon, llm, nbtr)      REAL tr_seri(klon, llm, nbtr)
     REAL d_tr(klon, llm, nbtr)  
518    
519      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
520    
# Line 565  contains Line 523  contains
523      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
524      REAL aam, torsfc      REAL aam, torsfc
525    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
526      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)  
527    
528      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
529    
530      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
531      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 578  contains Line 533  contains
533      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.
534    
535      REAL zsto      REAL zsto
   
     character(len = 20) modname  
     character(len = 80) abort_message  
     logical ok_sync  
536      real date0      real date0
537    
538      ! Variables liées au bilan d'énergie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
539      REAL ztsol(klon)      REAL ztsol(klon)
540      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
541      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
542      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
543      REAL zero_v(klon)      REAL zero_v(klon)
544      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 20) tit
545      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
546      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
547    
548      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
549      REAL ZRCPD      REAL ZRCPD
550    
551      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
552      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
553      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
554      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
555      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
556      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
557    
558        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
559    
560      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
561      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
562    
563      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
564      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
565    
566      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
567      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 618  contains Line 571  contains
571      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
572    
573      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL topswad(klon), solswad(klon) ! aerosol direct effect
     ! ok_ade --> ADE = topswad - topsw  
   
574      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_aie .and. ok_ade --> AIE = topswai - topswad  
     ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw  
575    
576      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
577    
# Line 630  contains Line 579  contains
579      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
580    
581      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
582      ! Parameters in the formula to link CDNC to aerosol mass conc      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
583      ! (Boucher and Lohmann, 1995), used in nuage.F      ! B). They link cloud droplet number concentration to aerosol mass
584        ! concentration.
585    
586      SAVE u10m      SAVE u10m
587      SAVE v10m      SAVE v10m
# Line 647  contains Line 597  contains
597      SAVE solswad      SAVE solswad
598      SAVE d_u_con      SAVE d_u_con
599      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
600    
601      real zmasse(klon, llm)      real zmasse(klon, llm)
602      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
# Line 662  contains Line 610  contains
610    
611      !----------------------------------------------------------------      !----------------------------------------------------------------
612    
613      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
614      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
615         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  
616    
617      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
618         ! initialiser         ! initialiser
# Line 687  contains Line 627  contains
627         cg_ae = 0.         cg_ae = 0.
628         rain_con(:) = 0.         rain_con(:) = 0.
629         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
630         topswai(:) = 0.         topswai(:) = 0.
631         topswad(:) = 0.         topswad(:) = 0.
632         solswai(:) = 0.         solswai(:) = 0.
633         solswad(:) = 0.         solswad(:) = 0.
634    
635         d_u_con = 0.0         d_u_con = 0.
636         d_v_con = 0.0         d_v_con = 0.
637         rnebcon0 = 0.0         rnebcon0 = 0.
638         clwcon0 = 0.0         clwcon0 = 0.
639         rnebcon = 0.0         rnebcon = 0.
640         clwcon = 0.0         clwcon = 0.
641    
642         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
643         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 720  contains Line 658  contains
658         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
659         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
660    
        ! Appel à la lecture du run.def physique  
661         call conf_phys         call conf_phys
662    
663         ! Initialiser les compteurs:         ! Initialiser les compteurs:
# Line 730  contains Line 667  contains
667         itaprad = 0         itaprad = 0
668         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
669              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
670              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
671              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
672              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
673    
674         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
675         q2 = 1.e-8         q2 = 1e-8
676    
677         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
678    
# Line 743  contains Line 680  contains
680         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
681    
682         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
683           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
684                ok_instan, ok_region)
685    
686         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
           ok_ocean = .TRUE.  
        ENDIF  
   
        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'  
687            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
688            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
689            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
690         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
691    
692         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
693         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
694            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
695              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
696         ENDIF         ENDIF
697    
698         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 792  contains Line 718  contains
718    
719         ! Initialisation des sorties         ! Initialisation des sorties
720    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
721         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
722         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
723         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
724         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
725      ENDIF test_firstcal      ENDIF test_firstcal
726    
727      ! 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  
728      da = 0.      da = 0.
729      mp = 0.      mp = 0.
730      phi = 0.      phi = 0.
731    
732      ! Ne pas affecter les valeurs entrées de u, v, h, et q :      ! We will modify variables *_seri and we will not touch variables
733        ! u, v, h, q:
734      DO k = 1, llm      DO k = 1, llm
735         DO i = 1, klon         DO i = 1, klon
736            t_seri(i, k) = t(i, k)            t_seri(i, k) = t(i, k)
# Line 848  contains Line 761  contains
761         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
762              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, &
763              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
764         ! Comme les tendances de la physique sont ajoutés dans la         ! Comme les tendances de la physique sont ajout\'es dans la
765         !  dynamique, la variation d'enthalpie par la dynamique devrait         !  dynamique, la variation d'enthalpie par la dynamique devrait
766         !  être égale à la variation de la physique au pas de temps         !  \^etre \'egale \`a la variation de la physique au pas de temps
767         !  précédent.  Donc la somme de ces 2 variations devrait être         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
768         !  nulle.         !  nulle.
769         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
770              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, &
# Line 869  contains Line 782  contains
782      ELSE      ELSE
783         DO k = 1, llm         DO k = 1, llm
784            DO i = 1, klon            DO i = 1, klon
785               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
786               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
787            ENDDO            ENDDO
788         ENDDO         ENDDO
789         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 893  contains Line 806  contains
806    
807      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
808    
809      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
810    
811      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
812      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
813    
814      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
815      DO k = 1, llm      DO k = 1, llm
816         DO i = 1, klon         DO i = 1, klon
817            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 923  contains Line 836  contains
836      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
837    
838      DO i = 1, klon      DO i = 1, klon
839         zxrugs(i) = 0.0         zxrugs(i) = 0.
840      ENDDO      ENDDO
841      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
842         DO i = 1, klon         DO i = 1, klon
# Line 956  contains Line 869  contains
869         ENDDO         ENDDO
870      ENDDO      ENDDO
871    
872      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
873      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
874    
875      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
876         DO i = 1, klon         DO i = 1, klon
877            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
878                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
879            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
880         ENDDO         ENDDO
881      ENDDO      ENDDO
882    
# Line 971  contains Line 884  contains
884    
885      ! Couche limite:      ! Couche limite:
886    
887      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
888           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
889           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
890           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
891           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
892           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
893           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, &
894           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
895           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
896           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
897    
898      ! Incrémentation des flux      ! Incr\'ementation des flux
899    
900      zxfluxt = 0.      zxfluxt = 0.
901      zxfluxq = 0.      zxfluxq = 0.
# Line 991  contains Line 904  contains
904      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
905         DO k = 1, llm         DO k = 1, llm
906            DO i = 1, klon            DO i = 1, klon
907               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
908                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
909               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
910                    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)  
911            END DO            END DO
912         END DO         END DO
913      END DO      END DO
914      DO i = 1, klon      DO i = 1, klon
915         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
916         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
917         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
918      ENDDO      ENDDO
919    
# Line 1030  contains Line 939  contains
939      ! Update surface temperature:      ! Update surface temperature:
940    
941      DO i = 1, klon      DO i = 1, klon
942         zxtsol(i) = 0.0         zxtsol(i) = 0.
943         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
944    
945         zt2m(i) = 0.0         zt2m(i) = 0.
946         zq2m(i) = 0.0         zq2m(i) = 0.
947         zu10m(i) = 0.0         zu10m(i) = 0.
948         zv10m(i) = 0.0         zv10m(i) = 0.
949         zxffonte(i) = 0.0         zxffonte(i) = 0.
950         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
951    
952         s_pblh(i) = 0.0         s_pblh(i) = 0.
953         s_lcl(i) = 0.0         s_lcl(i) = 0.
954         s_capCL(i) = 0.0         s_capCL(i) = 0.
955         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
956         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
957         s_pblT(i) = 0.0         s_pblT(i) = 0.
958         s_therm(i) = 0.0         s_therm(i) = 0.
959         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
960         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
961         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
962    
963         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
964              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
965              THEN              'physiq : probl\`eme sous surface au point ', i, &
966            WRITE(*, *) 'physiq : pb sous surface au point ', i, &              pctsrf(i, 1 : nbsrf)
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
967      ENDDO      ENDDO
968      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
969         DO i = 1, klon         DO i = 1, klon
# Line 1084  contains Line 991  contains
991         ENDDO         ENDDO
992      ENDDO      ENDDO
993    
994      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :
   
995      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
996         DO i = 1, klon         DO i = 1, klon
997            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1113  contains Line 1019  contains
1019      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1020    
1021      DO i = 1, klon      DO i = 1, klon
1022         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1023      ENDDO      ENDDO
1024    
1025      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1026    
1027      DO k = 1, llm      DO k = 1, llm
1028         DO i = 1, klon         DO i = 1, klon
1029            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1030                 + 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  
1031         ENDDO         ENDDO
1032      ENDDO      ENDDO
1033    
1034      IF (check) THEN      IF (check) THEN
1035         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1036         print *, "avantcon = ", za         print *, "avantcon = ", za
1037      ENDIF      ENDIF
     zx_ajustq = iflag_con == 2  
     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  
1038    
1039      select case (iflag_con)      if (iflag_con == 2) then
1040      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1041         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1042              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1043              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1044              pmflxs)              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1045                kdtop, pmflxr, pmflxs)
1046         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1047         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1048         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1049            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1050            itop_con(i) = llm + 1 - kctop(i)      else
1051         ENDDO         ! iflag_con >= 3
     case (3:)  
        ! number of tracers for the convection scheme of Kerry Emanuel:  
        ! la partie traceurs est faite dans phytrac  
        ! on met ntra = 1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.  
        ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        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  
1052    
1053         IF (.NOT. ok_gust) THEN         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
1054            do i = 1, klon              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
1055               wd(i) = 0.0              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
1056            enddo              qcondc, wd, pmflxr, pmflxs, da, phi, mp)
1057         ENDIF         clwcon0 = qcondc
1058           mfu = upwd + dnwd
1059           IF (.NOT. ok_gust) wd = 0.
1060    
1061         ! Calcul des propriétés des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1062    
1063         DO k = 1, llm         DO k = 1, llm
1064            DO i = 1, klon            DO i = 1, klon
              zx_t = t_seri(i, k)  
1065               IF (thermcep) THEN               IF (thermcep) THEN
1066                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k)))
1067                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k)
1068                  zx_qs = MIN(0.5, zx_qs)                  zqsat(i, k) = MIN(0.5, zqsat(i, k))
1069                  zcor = 1./(1.-retv*zx_qs)                  zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k))
                 zx_qs = zx_qs*zcor  
1070               ELSE               ELSE
1071                  IF (zx_t < t_coup) THEN                  IF (t_seri(i, k) < t_coup) THEN
1072                     zx_qs = qsats(zx_t)/play(i, k)                     zqsat(i, k) = qsats(t_seri(i, k))/play(i, k)
1073                  ELSE                  ELSE
1074                     zx_qs = qsatl(zx_t)/play(i, k)                     zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k)
1075                  ENDIF                  ENDIF
1076               ENDIF               ENDIF
              zqsat(i, k) = zx_qs  
1077            ENDDO            ENDDO
1078         ENDDO         ENDDO
1079    
1080         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1081         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1082         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1083              rnebcon0)              rnebcon0)
1084      case default  
1085         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1086         stop 1         pen_u = 0.
1087      END select         pen_d = 0.
1088           pde_d = 0.
1089           pde_u = 0.
1090        END if
1091    
1092      DO k = 1, llm      DO k = 1, llm
1093         DO i = 1, klon         DO i = 1, klon
# Line 1232  contains Line 1111  contains
1111      IF (check) THEN      IF (check) THEN
1112         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1113         print *, "aprescon = ", za         print *, "aprescon = ", za
1114         zx_t = 0.0         zx_t = 0.
1115         za = 0.0         za = 0.
1116         DO i = 1, klon         DO i = 1, klon
1117            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1118            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
# Line 1242  contains Line 1121  contains
1121         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1122         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1123      ENDIF      ENDIF
1124      IF (zx_ajustq) THEN  
1125         DO i = 1, klon      IF (iflag_con == 2) THEN
1126            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1127         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  
1128         DO k = 1, llm         DO k = 1, llm
1129            DO i = 1, klon            DO i = 1, klon
1130               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 1264  contains Line 1133  contains
1133            ENDDO            ENDDO
1134         ENDDO         ENDDO
1135      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1136    
1137      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1138    
1139      d_t_ajs = 0.      d_t_ajs = 0.
1140      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1295  contains Line 1163  contains
1163    
1164      ! Caclul des ratqs      ! Caclul des ratqs
1165    
1166      ! 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
1167      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1168      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1169         do k = 1, llm         do k = 1, llm
1170            do i = 1, klon            do i = 1, klon
1171               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1172                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1173                       +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)
1174               else               else
1175                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1176               endif               endif
# Line 1313  contains Line 1181  contains
1181      ! ratqs stables      ! ratqs stables
1182      do k = 1, llm      do k = 1, llm
1183         do i = 1, klon         do i = 1, klon
1184            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1185                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1186         enddo         enddo
1187      enddo      enddo
1188    
1189      ! ratqs final      ! ratqs final
1190      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1191         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1192         ! ratqs final         ! ratqs final
1193         ! 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
1194         ! relaxation des ratqs         ! relaxation des ratqs
1195         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1196         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1197      else      else
1198         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1199         ratqs = ratqss         ratqs = ratqss
1200      endif      endif
1201    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1202      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1203           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, &
1204           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1353  contains Line 1218  contains
1218      IF (check) THEN      IF (check) THEN
1219         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1220         print *, "apresilp = ", za         print *, "apresilp = ", za
1221         zx_t = 0.0         zx_t = 0.
1222         za = 0.0         za = 0.
1223         DO i = 1, klon         DO i = 1, klon
1224            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1225            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
# Line 1396  contains Line 1261  contains
1261         endif         endif
1262    
1263         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1264         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1265              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1266         DO k = 1, llm         DO k = 1, llm
1267            DO i = 1, klon            DO i = 1, klon
1268               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1408  contains Line 1272  contains
1272            ENDDO            ENDDO
1273         ENDDO         ENDDO
1274      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1275         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1276         ! 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
1277         ! facttemps         ! d'un facteur facttemps.
1278         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1279         do k = 1, llm         do k = 1, llm
1280            do i = 1, klon            do i = 1, klon
1281               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1282               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1283                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1284                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1285                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1286               endif               endif
# Line 1452  contains Line 1316  contains
1316           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1317           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1318    
1319      ! Humidité relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
1320      DO k = 1, llm      DO k = 1, llm
1321         DO i = 1, klon         DO i = 1, klon
1322            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1488  contains Line 1352  contains
1352         cg_ae = 0.         cg_ae = 0.
1353      ENDIF      ENDIF
1354    
1355      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Param\`etres optiques des nuages et quelques param\`etres pour
1356        ! diagnostics :
1357      if (ok_newmicro) then      if (ok_newmicro) then
1358         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1359              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1360              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1361      else      else
1362         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1363              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 1407  contains
1407    
1408      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1409      DO i = 1, klon      DO i = 1, klon
1410         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1411         zxsnow(i) = 0.0         zxsnow(i) = 0.
1412      ENDDO      ENDDO
1413      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1414         DO i = 1, klon         DO i = 1, klon
# Line 1553  contains Line 1417  contains
1417         ENDDO         ENDDO
1418      ENDDO      ENDDO
1419    
1420      ! 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)
1421    
1422      DO i = 1, klon      DO i = 1, klon
1423         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1424      ENDDO      ENDDO
1425    
1426      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1427    
1428      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1429         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1430         igwd = 0         igwd = 0
1431         DO i = 1, klon         DO i = 1, klon
1432            itest(i) = 0            itest(i) = 0
1433            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1434               itest(i) = 1               itest(i) = 1
1435               igwd = igwd + 1               igwd = igwd + 1
1436               idx(igwd) = i               idx(igwd) = i
# Line 1588  contains Line 1452  contains
1452      ENDIF      ENDIF
1453    
1454      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1455         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
1456         igwd = 0         igwd = 0
1457         DO i = 1, klon         DO i = 1, klon
1458            itest(i) = 0            itest(i) = 0
# Line 1613  contains Line 1477  contains
1477         ENDDO         ENDDO
1478      ENDIF      ENDIF
1479    
1480      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
1481    
1482      DO i = 1, klon      DO i = 1, klon
1483         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1637  contains Line 1501  contains
1501    
1502      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1503      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1504           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1505           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1506           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1507           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1508    
1509      IF (offline) THEN      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1510         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1511              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1512    
1513      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1514      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 1689  contains Line 1551  contains
1551    
1552      ! SORTIES      ! SORTIES
1553    
1554      !cc prw = eau precipitable      ! prw = eau precipitable
1555      DO i = 1, klon      DO i = 1, klon
1556         prw(i) = 0.         prw(i) = 0.
1557         DO k = 1, llm         DO k = 1, llm
# Line 1728  contains Line 1590  contains
1590      ENDDO      ENDDO
1591    
1592      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1593      call write_histins      call write_histins
1594    
1595      ! 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 1737  contains Line 1597  contains
1597         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1598         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1599              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1600              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1601              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1602              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1603      ENDIF      ENDIF
1604    
1605      firstcal = .FALSE.      firstcal = .FALSE.
1606    
1607    contains    contains
1608    
     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  
   
     !***************************************************************  
   
1609      subroutine write_histins      subroutine write_histins
1610    
1611        ! 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
1612    
1613          use dimens_m, only: iim, jjm
1614          USE histsync_m, ONLY: histsync
1615          USE histwrite_m, ONLY: histwrite
1616    
1617        real zout        real zout
1618        integer itau_w ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1619          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1620    
1621        !--------------------------------------------------        !--------------------------------------------------
1622    
# Line 2006  contains Line 1832  contains
1832           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)
1833           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1834    
1835           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1836        ENDIF        ENDIF
1837    
1838      end subroutine write_histins      end subroutine write_histins
1839    
     !****************************************************  
   
     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  
   
1840    END SUBROUTINE physiq    END SUBROUTINE physiq
1841    
1842  end module physiq_m  end module physiq_m
Legend:
Removed from v.68  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.21