/[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/phylmd/physiq.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/Sources/phylmd/physiq.f revision 209 by guez, Wed Dec 7 17:37:21 2016 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         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      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
12    
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      use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
     use aeropt_m, only: aeropt  
19      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
     USE calendar, ONLY: ymds2ju  
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
21      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ok_instan
23      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
          ok_orodr, ok_orolf, soil_model  
24      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
25      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
27        USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31      use conflx_m, only: conflx      use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
34      use diagetpq_m, only: diagetpq      USE dimens_m, ONLY: llm, nqmx
35      use diagphy_m, only: diagphy      USE dimphy, ONLY: klon
     USE dimens_m, ONLY: iim, jjm, llm, nqmx  
     USE dimphy, ONLY: klon, nbtr  
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      use dynetat0_m, only: day_ref, annee_ref
39        USE fcttre, ONLY: foeew, qsatl, qsats
40      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
43      USE histwrite_m, ONLY: histwrite      USE histwrite_phy_m, ONLY: histwrite_phy
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
46      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histins_m, ONLY: ini_histins, nid_ins
47      USE ini_histday_m, ONLY: ini_histday      use netcdf95, only: NF95_CLOSE
     USE ini_histins_m, ONLY: ini_histins  
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49      USE oasis_m, ONLY: ok_oasis      use nr_util, only: assert
50      USE orbite_m, ONLY: orbite, zenang      use nuage_m, only: nuage
51        USE orbite_m, ONLY: orbite
52      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
53      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
54      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
55        USE phyredem0_m, ONLY: phyredem0
56      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
57      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
59      use readsulfate_m, only: readsulfate      use yoegwd, only: sugwd
60      use sugwd_m, only: sugwd      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use time_phylmdz, only: itap, increment_itap
62      USE temps, ONLY: annee_ref, day_ref, itau_phy      use transp_m, only: transp
63        use transp_lay_m, only: transp_lay
64      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
65        USE ymds2ju_m, ONLY: ymds2ju
66      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
67        use zenang_m, only: zenang
68    
     ! Arguments:  
   
     REAL, intent(in):: rdayvrai  
     ! (elapsed time since January 1st 0h of the starting year, in days)  
   
     REAL, intent(in):: time ! heure de la journée en fraction de jour  
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
69      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
70    
71      REAL, intent(in):: paprs(klon, llm + 1)      integer, intent(in):: dayvrai
72      ! (pression pour chaque inter-couche, en Pa)      ! current day number, based at value 1 on January 1st of annee_ref
73    
74      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     ! (input pression pour le mileu de chaque couche (en Pa))  
75    
76      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
77      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! pression pour chaque inter-couche, en Pa
78    
79      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: play(:, :) ! (klon, llm)
80        ! pression pour le mileu de chaque couche (en Pa)
81    
82      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
83      ! vitesse dans la direction X (de O a E) en m/s      ! géopotentiel de chaque couche (référence sol)
84    
85      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
     REAL, intent(in):: t(klon, llm) ! input temperature (K)  
86    
87      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: u(:, :) ! (klon, llm)
88      ! (humidité spécifique et fractions massiques des autres traceurs)      ! vitesse dans la direction X (de O a E) en m / s
89    
90      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
     REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)  
     REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)  
     REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon) ! output tendance physique de la pression au sol  
92    
93      LOGICAL:: firstcal = .true.      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94        ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95    
96      INTEGER nbteta      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97      PARAMETER(nbteta = 3)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
98        REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
99        REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100    
101      REAL PVteta(klon, nbteta)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102      ! (output vorticite potentielle a des thetas constantes)      ! tendance physique de "qx" (s-1)
103    
104      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      ! Local:
     PARAMETER (ok_gust = .FALSE.)  
105    
106      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL:: firstcal = .true.
     PARAMETER (check = .FALSE.)  
107    
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
111      ! Parametres lies au coupleur OASIS:      ! pour phystoke avec thermiques
     INTEGER, SAVE:: npas, nexca  
     logical rnpb  
     parameter(rnpb = .true.)  
   
     character(len = 6):: ocean = 'force '  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
   
     ! "slab" ocean  
     REAL, save:: tslab(klon) ! temperature of ocean slab  
     REAL, save:: seaice(klon) ! glace de mer (kg/m2)  
     REAL fluxo(klon) ! flux turbulents ocean-glace de mer  
     REAL fluxg(klon) ! flux turbulents ocean-atmosphere  
   
     ! Modele thermique du sol, a activer pour le cycle diurne:  
     logical:: ok_veget = .false. ! type de modele de vegetation utilise  
   
     logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.  
     ! sorties journalieres, mensuelles et instantanees dans les  
     ! fichiers histday, histmth et histins  
   
     LOGICAL ok_region ! sortir le fichier regional  
     PARAMETER (ok_region = .FALSE.)  
   
     ! pour phsystoke avec thermiques  
112      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
113      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
114      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
115    
116      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
117      PARAMETER (ivap = 1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq = 2)  
118    
119      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
120      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
121    
122      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
123      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126    
127      !IM Amip2 PV a theta constante      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128        REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129    
130      CHARACTER(LEN = 3) ctetaSTD(nbteta)      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      DATA ctetaSTD/'350', '380', '405'/      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
     REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)  
     REAL swup0(klon, llm + 1), swup(klon, llm + 1)  
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)  
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     !IM Amip2  
     ! variables a une pression donnee  
   
     integer nlevSTD  
     PARAMETER(nlevSTD = 17)  
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN = 4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70 ', '50 ', '30 ', '20 ', '10 '/  
132    
133      ! prw: precipitable water      ! prw: precipitable water
134      real prw(klon)      real prw(klon)
135    
136      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
137      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
138      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
139      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
140    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)  
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN = 4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN = 3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     !IM ISCCP simulator v3.4  
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
   
141      ! Variables propres a la physique      ! Variables propres a la physique
142    
143      INTEGER, save:: radpas      INTEGER, save:: radpas
144      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
145      ! "physiq".)      ! "physiq".
   
     REAL radsol(klon)  
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
   
     INTEGER, SAVE:: itap ! number of calls to "physiq"  
146    
147        REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
148      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
149    
150      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
151      ! soil temperature of surface fraction      ! soil temperature of surface fraction
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
   
     REAL fqsurf(klon, nbsrf)  
     SAVE fqsurf ! humidite de l'air au contact de la surface  
155    
156      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: fqsurf(klon, nbsrf)
157        ! humidite de l'air au contact de la surface
158    
159      REAL fsnow(klon, nbsrf)      REAL, save:: qsol(klon)
160      SAVE fsnow ! epaisseur neigeuse      ! column-density of water in soil, in kg m-2
161    
162      REAL falbe(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
163      SAVE falbe ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL falblw(klon, nbsrf)  
     SAVE falblw ! albedo par type de surface  
164    
165      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
166      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
167      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
168      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 294  contains Line 171  contains
171      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
172      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
173      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
174      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
175        INTEGER igwd, itest(klon)
176    
177      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
178        REAL, save:: run_off_lic_0(klon)
     REAL agesno(klon, nbsrf)  
     SAVE agesno ! age de la neige  
179    
180      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
181      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
182      !KE43      REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
     REAL Ma(klon, llm) ! undilute upward mass flux  
     SAVE Ma  
     REAL qcondc(klon, llm) ! in-cld water content from convect  
     SAVE qcondc  
183      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables locales pour la couche limite (al1):  
   
     ! Variables locales:  
184    
185        ! Variables pour la couche limite (Alain Lahellec) :
186      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
187      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
188    
# Line 329  contains Line 190  contains
190      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
191      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
192      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
193      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
194      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: ffonte(klon, nbsrf)
195      ! !et necessaire pour limiter la      ! flux thermique utilise pour fondre la neige
196      ! !hauteur de neige, en kg/m2/s  
197        REAL, save:: fqcalving(klon, nbsrf)
198        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
199        ! hauteur de neige, en kg / m2 / s
200    
201      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
202    
203      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
204      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
205      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
206      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
207      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
208      save pfrac_1nucl  
209      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
210      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
211    
212      REAL, save:: rain_fall(klon) ! pluie      REAL, save:: rain_fall(klon)
213      REAL, save:: snow_fall(klon) ! neige      ! liquid water mass flux (kg / m2 / s), positive down
214    
215        REAL, save:: snow_fall(klon)
216        ! solid water mass flux (kg / m2 / s), positive down
217    
218      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
219    
220      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
221      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
222      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
223      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
224        REAL, save:: dlw(klon) ! derivee infra rouge
225      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
226      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
227      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
228      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
229      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
230      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
231    
232      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
233      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
234    
235      ! Conditions aux limites      ! Conditions aux limites
236    
237      INTEGER julien      INTEGER julien
   
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
238      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
239      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total visible
   
     REAL albsol(klon)  
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
240      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
241    
     ! Declaration des procedures appelees  
   
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
242      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
243      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
244    
# Line 401  contains Line 250  contains
250      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
251      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
252    
253      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
254      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
255      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
256      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_v(klon, nbsrf) ! flux turbulent de vitesse v à la surface
   
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
257    
258      ! 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
259      ! les variables soient rémanentes.      ! les variables soient r\'emanentes.
260      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
261      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
262      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
263      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
264      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
265      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
266      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
267      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
268      REAL albpla(klon)      REAL, save:: albpla(klon)
269      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
270      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
271      SAVE albpla  
272      SAVE heat0, cool0      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
273        REAL conv_t(klon, llm) ! convergence of temperature (K / s)
274      INTEGER itaprad  
275      SAVE itaprad      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
276        REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
277      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)  
278      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
279    
280      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL dist, mu0(klon), fract(klon)
281      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      real longi
   
     REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)  
   
     REAL dist, rmu0(klon), fract(klon)  
     REAL zdtime ! pas de temps du rayonnement (s)  
     real zlongi  
282      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
283      REAL za, zb      REAL zb
284      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
285      real zqsat(klon, llm)      real zqsat(klon, llm)
286      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
287      REAL zphi(klon, llm)      REAL zphi(klon, llm)
288    
289      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
290    
291      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
292      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
293      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
294      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
295      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
296      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
297      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
298      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
299      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
300      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
301      ! Grdeurs de sorties      ! Grandeurs de sorties
302      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
303      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
304      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
305      REAL s_trmb3(klon)      REAL s_trmb3(klon)
306    
307      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
308    
309      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
310      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
311      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
312      REAL tvp(klon, llm) ! virtual temp of lifted parcel  
     REAL cape(klon) ! CAPE  
     SAVE cape  
   
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
313      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
314    
315      ! Variables du changement      ! Variables du changement
316    
317      ! con: convection      ! con: convection
318      ! lsc: large scale condensation      ! lsc: large scale condensation
319      ! ajs: ajustement sec      ! ajs: ajustement sec
320      ! eva: évaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
321      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
322      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
323      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
324      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
325      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
326      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 508  contains Line 334  contains
334      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
335    
336      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
337        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
338    
339      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
340      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
341        REAL, save:: snow_con(klon) ! neige (mm / s)
342        real snow_lsc(klon)
343      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
344    
345      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 534  contains Line 363  contains
363      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
364      logical ptconv(klon, llm)      logical ptconv(klon, llm)
365    
366      ! Variables locales pour effectuer les appels en série :      ! Variables pour effectuer les appels en s\'erie :
367    
368      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
369      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
370      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
371        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
372    
373      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
374    
# Line 550  contains Line 377  contains
377      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
378      REAL aam, torsfc      REAL aam, torsfc
379    
     REAL dudyn(iim + 1, jjm + 1, llm)  
   
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
     INTEGER, SAVE:: nid_day, nid_ins  
   
380      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.
381      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.
382      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
383      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.
384    
     REAL zsto  
   
     logical ok_sync  
385      real date0      real date0
   
     ! Variables liées au bilan d'énergie et d'enthalpie :  
386      REAL ztsol(klon)      REAL ztsol(klon)
     REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec  
     REAL, SAVE:: d_h_vcol_phy  
     REAL fs_bound, fq_bound  
     REAL zero_v(klon)  
     CHARACTER(LEN = 15) tit  
     INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
     INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation  
387    
388      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm)
389        ! tendance due \`a la conversion Ec en énergie thermique
390    
391      REAL ZRCPD      REAL ZRCPD
392    
393      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
394      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
395      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
396      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
397        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
398        REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
399    
400      ! Aerosol effects:      ! Aerosol effects:
401    
402      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
403    
404      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
405      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
406    
407      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
408      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial aerosols
409    
410      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
411      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 602  contains Line 414  contains
414      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
415      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
416    
417      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
418      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
   
     REAL aerindex(klon) ! POLDER aerosol index  
419    
420      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
421      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 615  contains Line 425  contains
425      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
426      ! concentration.      ! concentration.
427    
428      SAVE u10m      real zmasse(klon, llm)
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
     real zmasse(klon, llm)  
429      ! (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)
430    
431      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
432    
433      namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
434           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
435           ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &           iflag_thermals, nsplit_thermals
          nsplit_thermals  
436    
437      !----------------------------------------------------------------      !----------------------------------------------------------------
438    
     IF (if_ebil >= 1) zero_v = 0.  
     ok_sync = .TRUE.  
439      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
440           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
441    
442      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
443         ! initialiser         ! initialiser
# Line 658  contains Line 450  contains
450         piz_ae = 0.         piz_ae = 0.
451         tau_ae = 0.         tau_ae = 0.
452         cg_ae = 0.         cg_ae = 0.
453         rain_con(:) = 0.         rain_con = 0.
454         snow_con(:) = 0.         snow_con = 0.
455         topswai(:) = 0.         topswai = 0.
456         topswad(:) = 0.         topswad = 0.
457         solswai(:) = 0.         solswai = 0.
458         solswad(:) = 0.         solswad = 0.
459    
460         d_u_con = 0.         d_u_con = 0.
461         d_v_con = 0.         d_v_con = 0.
# Line 677  contains Line 469  contains
469         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
470         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
471         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
472         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
473         therm =0.         therm =0.
474         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
475         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
476         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
477    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
478         iflag_thermals = 0         iflag_thermals = 0
479         nsplit_thermals = 1         nsplit_thermals = 1
480         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 696  contains Line 486  contains
486         ! Initialiser les compteurs:         ! Initialiser les compteurs:
487    
488         frugs = 0.         frugs = 0.
489         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
490         itaprad = 0              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
491         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
492              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
493              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &              w01, ncid_startphy)
             zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &  
             ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)  
494    
495         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
496         q2 = 1e-8         q2 = 1e-8
497    
498         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = lmt_pas / nbapp_rad
499           print *, "radpas = ", radpas
        ! on remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
500    
501         PRINT *, 'cycle_diurne = ', cycle_diurne         ! Initialisation pour le sch\'ema de convection d'Emanuel :
502         CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &         IF (conv_emanuel) THEN
             ok_instan, ok_region)  
   
        IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
        ! Initialisation pour le schéma de convection d'Emanuel :  
        IF (iflag_con >= 3) THEN  
503            ibas_con = 1            ibas_con = 1
504            itop_con = 1            itop_con = 1
505         ENDIF         ENDIF
# Line 735  contains Line 511  contains
511            rugoro = 0.            rugoro = 0.
512         ENDIF         ENDIF
513    
514         lmt_pas = NINT(86400. / dtphys) ! tous les jours         ecrit_ins = NINT(ecrit_ins / dtphys)
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
        ecrit_ins = NINT(ecrit_ins/dtphys)  
        ecrit_hf = NINT(ecrit_hf/dtphys)  
        ecrit_mth = NINT(ecrit_mth/dtphys)  
        ecrit_tra = NINT(86400.*ecrit_tra/dtphys)  
        ecrit_reg = NINT(ecrit_reg/dtphys)  
   
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
515    
516         ! Initialisation des sorties         ! Initialisation des sorties
517    
518         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histins(dtphys)
519         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
        call ini_histins(dtphys, ok_instan, nid_ins)  
        CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)  
520         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
521         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
522           CALL phyredem0
523      ENDIF test_firstcal      ENDIF test_firstcal
524    
525      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
526        ! u, v, t, qx:
527      DO i = 1, klon      t_seri = t
528         d_ps(i) = 0.      u_seri = u
529      ENDDO      v_seri = v
530      DO iq = 1, nqmx      q_seri = qx(:, :, ivap)
531         DO k = 1, llm      ql_seri = qx(:, :, iliq)
532            DO i = 1, klon      tr_seri = qx(:, :, 3:nqmx)
              d_qx(i, k, iq) = 0.  
           ENDDO  
        ENDDO  
     ENDDO  
     da = 0.  
     mp = 0.  
     phi = 0.  
   
     ! Ne pas affecter les valeurs entrées de u, v, h, et q :  
   
     DO k = 1, llm  
        DO i = 1, klon  
           t_seri(i, k) = t(i, k)  
           u_seri(i, k) = u(i, k)  
           v_seri(i, k) = v(i, k)  
           q_seri(i, k) = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
   
     DO i = 1, klon  
        ztsol(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
533    
534      IF (if_ebil >= 1) THEN      ztsol = sum(ftsol * pctsrf, dim = 2)
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        ! Comme les tendances de la physique sont ajoutés dans la  
        !  dynamique, la variation d'enthalpie par la dynamique devrait  
        !  être égale à la variation de la physique au pas de temps  
        !  précédent.  Donc la somme de ces 2 variations devrait être  
        !  nulle.  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &  
             d_qt, 0., fs_bound, fq_bound)  
     END IF  
535    
536      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
537      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 845  contains Line 561  contains
561      ! Check temperatures:      ! Check temperatures:
562      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
563    
564      ! Incrementer le compteur de la physique      call increment_itap
565      itap = itap + 1      julien = MOD(dayvrai, 360)
     julien = MOD(NINT(rdayvrai), 360)  
566      if (julien == 0) julien = 360      if (julien == 0) julien = 360
567    
568      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
   
     ! Mettre en action les conditions aux limites (albedo, sst etc.).  
569    
570      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone :
571      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
572    
573      ! Évaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
574      DO k = 1, llm      DO k = 1, llm
575         DO i = 1, klon         DO i = 1, klon
576            zb = MAX(0., ql_seri(i, k))            zb = MAX(0., ql_seri(i, k))
# Line 868  contains Line 581  contains
581      ENDDO      ENDDO
582      ql_seri = 0.      ql_seri = 0.
583    
584      IF (if_ebil >= 2) THEN      frugs = MAX(frugs, 0.000015)
585         tit = 'after reevap'      zxrugs = sum(frugs * pctsrf, dim = 2)
        CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
586    
587      END IF      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
588        ! la surface.
     ! Appeler la diffusion verticale (programme de couche limite)  
   
     DO i = 1, klon  
        zxrugs(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
589    
590      ! calculs necessaires au calcul de l'albedo dans l'interface      CALL orbite(REAL(julien), longi, dist)
591        CALL zenang(longi, time, dtphys * radpas, mu0, fract)
     CALL orbite(REAL(julien), zlongi, dist)  
     IF (cycle_diurne) THEN  
        zdtime = dtphys * REAL(radpas)  
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
     ELSE  
        rmu0 = -999.999  
     ENDIF  
592    
593      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
594      albsol(:) = 0.      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw(:) = 0.  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)  
           albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
595    
596      ! Répartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
597      ! Répartition du longwave par sous-surface linéarisée      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
598    
599      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
600         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
601            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
602                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
603            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))      END forall
        ENDDO  
     ENDDO  
604    
605      fder = dlw      fder = dlw
606    
607      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
608             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
609      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
610           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &           snow_fall, fsolsw, fsollw, fder, frugs, agesno, rugoro, d_t_vdf, &
611           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
612           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, &
613           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &           v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, &
614           frugs, firstcal, agesno, rugoro, d_t_vdf, &           plcl, fqcalving, ffonte, run_off_lic_0)
615           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &  
616           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &      ! Incr\'ementation des flux
617           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &  
618           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)      sens = - sum(flux_t * pctsrf, dim = 2)
619        evap = - sum(flux_q * pctsrf, dim = 2)
620      ! Incrémentation des flux      fder = dlw + dsens + devap
   
     zxfluxt = 0.  
     zxfluxq = 0.  
     zxfluxu = 0.  
     zxfluxv = 0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) + fluxq(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)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
621    
622      DO k = 1, llm      DO k = 1, llm
623         DO i = 1, klon         DO i = 1, klon
# Line 972  contains Line 628  contains
628         ENDDO         ENDDO
629      ENDDO      ENDDO
630    
     IF (if_ebil >= 2) THEN  
        tit = 'after clmain'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
     END IF  
   
631      ! Update surface temperature:      ! Update surface temperature:
632    
633      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
634         zxtsol(i) = 0.      ftsol = ftsol + d_ts
635         zxfluxlat(i) = 0.      ztsol = sum(ftsol * pctsrf, dim = 2)
636        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
637         zt2m(i) = 0.      zt2m = sum(t2m * pctsrf, dim = 2)
638         zq2m(i) = 0.      zq2m = sum(q2m * pctsrf, dim = 2)
639         zu10m(i) = 0.      zu10m = sum(u10m * pctsrf, dim = 2)
640         zv10m(i) = 0.      zv10m = sum(v10m * pctsrf, dim = 2)
641         zxffonte(i) = 0.      zxffonte = sum(ffonte * pctsrf, dim = 2)
642         zxfqcalving(i) = 0.      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
643        s_pblh = sum(pblh * pctsrf, dim = 2)
644         s_pblh(i) = 0.      s_lcl = sum(plcl * pctsrf, dim = 2)
645         s_lcl(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
646         s_capCL(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
647         s_oliqCL(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
648         s_cteiCL(i) = 0.      s_pblT = sum(pblT * pctsrf, dim = 2)
649         s_pblT(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
650         s_therm(i) = 0.      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
651         s_trmb1(i) = 0.      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
652         s_trmb2(i) = 0.      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
        s_trmb3(i) = 0.  
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &  
             + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &  
             'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)  
           zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)  
           zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)  
           zxfqcalving(i) = zxfqcalving(i) + &  
                fqcalving(i, nsrf)*pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne  
653    
654        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
655      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
656         DO i = 1, klon         DO i = 1, klon
657            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
658                 ftsol(i, nsrf) = ztsol(i)
659            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
660            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
661            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
662            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
663            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
664            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
665                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
666            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
667            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
668            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
669            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
670            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
671            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
672            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
673            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
674            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
675            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
676         ENDDO         ENDDO
677      ENDDO      ENDDO
678    
679      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
680    
681      DO i = 1, klon      DO i = 1, klon
682         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
683      ENDDO      ENDDO
684    
685      ! Appeler la convection (au choix)      ! Appeler la convection
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys  
           conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys  
        ENDDO  
     ENDDO  
   
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon = ", za  
     ENDIF  
   
     if (iflag_con == 2) then  
        z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)  
        CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &  
             q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &  
             mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &  
             kdtop, pmflxr, pmflxs)  
        WHERE (rain_con < 0.) rain_con = 0.  
        WHERE (snow_con < 0.) snow_con = 0.  
        ibas_con = llm + 1 - kcbot  
        itop_con = llm + 1 - kctop  
     else  
        ! iflag_con >= 3  
   
        CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &  
             v_seri, tr_seri, sig1, w01, 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, ntra=1)  
        ! (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.)  
686    
687        if (conv_emanuel) then
688           CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
689                d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
690                upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
691           snow_con = 0.
692         clwcon0 = qcondc         clwcon0 = qcondc
693         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
694    
695         ! Calcul des propriétés des nuages convectifs         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
696           zqsat = zqsat / (1. - retv * zqsat)
697    
698         DO k = 1, llm         ! Properties of convective clouds
           DO i = 1, klon  
              zx_t = t_seri(i, k)  
              IF (thermcep) THEN  
                 zdelta = MAX(0., SIGN(1., rtt-zx_t))  
                 zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)  
                 zx_qs = MIN(0.5, zx_qs)  
                 zcor = 1./(1.-retv*zx_qs)  
                 zx_qs = zx_qs*zcor  
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/play(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/play(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k) = zx_qs  
           ENDDO  
        ENDDO  
   
        ! calcul des proprietes des nuages convectifs  
699         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
700         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
701              rnebcon0)              rnebcon0)
702    
703           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
704         mfd = 0.         mfd = 0.
705         pen_u = 0.         pen_u = 0.
706         pen_d = 0.         pen_d = 0.
707         pde_d = 0.         pde_d = 0.
708         pde_u = 0.         pde_u = 0.
709        else
710           conv_q = d_q_dyn + d_q_vdf / dtphys
711           conv_t = d_t_dyn + d_t_vdf / dtphys
712           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
713           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
714                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
715                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
716                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
717                kdtop, pmflxr, pmflxs)
718           WHERE (rain_con < 0.) rain_con = 0.
719           WHERE (snow_con < 0.) snow_con = 0.
720           ibas_con = llm + 1 - kcbot
721           itop_con = llm + 1 - kctop
722      END if      END if
723    
724      DO k = 1, llm      DO k = 1, llm
# Line 1154  contains Line 730  contains
730         ENDDO         ENDDO
731      ENDDO      ENDDO
732    
733      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (iflag_con == 2) THEN  
734         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
735         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
736         DO k = 1, llm         DO k = 1, llm
# Line 1190  contains Line 742  contains
742         ENDDO         ENDDO
743      ENDIF      ENDIF
744    
745      ! Convection sèche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
746    
747      d_t_ajs = 0.      d_t_ajs = 0.
748      d_u_ajs = 0.      d_u_ajs = 0.
# Line 1205  contains Line 757  contains
757         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
758         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
759      else      else
        ! Thermiques  
760         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
761              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
762      endif      endif
763    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
764      ! Caclul des ratqs      ! Caclul des ratqs
765    
766      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
767      ! on écrase le tableau ratqsc calculé par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
768      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
769         do k = 1, llm         do k = 1, llm
770            do i = 1, klon            do i = 1, klon
# Line 1238  contains Line 782  contains
782      do k = 1, llm      do k = 1, llm
783         do i = 1, klon         do i = 1, klon
784            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
785                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
786         enddo         enddo
787      enddo      enddo
788    
# Line 1271  contains Line 815  contains
815            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
816         ENDDO         ENDDO
817      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        tit = 'after fisrt'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
     END IF  
818    
819      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
820    
821      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
822    
823      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
824         ! seulement pour Tiedtke         ! seulement pour Tiedtke
825         snow_tiedtke = 0.         snow_tiedtke = 0.
826         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
827            rain_tiedtke = rain_con            rain_tiedtke = rain_con
828         else         else
829            rain_tiedtke = 0.            rain_tiedtke = 0.
830            do k = 1, llm            do k = 1, llm
831               do i = 1, klon               do i = 1, klon
832                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
833                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
834                          *zmasse(i, k)                          * zmasse(i, k)
835                  endif                  endif
836               enddo               enddo
837            enddo            enddo
# Line 1329  contains Line 850  contains
850         ENDDO         ENDDO
851      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
852         ! On prend pour les nuages convectifs le maximum du calcul de         ! On prend pour les nuages convectifs le maximum du calcul de
853         ! la convection et du calcul du pas de temps précédent diminué         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
854         ! d'un facteur facttemps.         ! d'un facteur facttemps.
855         facteur = dtphys * facttemps         facteur = dtphys * facttemps
856         do k = 1, llm         do k = 1, llm
# Line 1345  contains Line 866  contains
866    
867         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
868         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
869         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
870      ENDIF      ENDIF
871    
872      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1368  contains Line 889  contains
889         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
890      ENDDO      ENDDO
891    
892      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &      ! Humidit\'e relative pour diagnostic :
          dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &  
          d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
   
     ! Humidité relative pour diagnostic :  
893      DO k = 1, llm      DO k = 1, llm
894         DO i = 1, klon         DO i = 1, klon
895            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
896            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
897               zdelta = MAX(0., SIGN(1., rtt-zx_t))            zx_qs = MIN(0.5, zx_qs)
898               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)            zcor = 1. / (1. - retv * zx_qs)
899               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
900               zcor = 1./(1.-retv*zx_qs)            zx_rh(i, k) = q_seri(i, k) / zx_qs
              zx_qs = zx_qs*zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/play(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
901            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
902         ENDDO         ENDDO
903      ENDDO      ENDDO
904    
905      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
906      IF (ok_ade .OR. ok_aie) THEN      tau_ae = 0.
907         ! Get sulfate aerosol distribution :      piz_ae = 0.
908         CALL readsulfate(rdayvrai, firstcal, sulfate)      cg_ae = 0.
        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)  
909    
910         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &      ! Param\`etres optiques des nuages et quelques param\`etres pour
911              aerindex)      ! diagnostics :
     ELSE  
        tau_ae = 0.  
        piz_ae = 0.  
        cg_ae = 0.  
     ENDIF  
   
     ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :  
912      if (ok_newmicro) then      if (ok_newmicro) then
913         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
914              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
# Line 1419  contains Line 919  contains
919              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
920      endif      endif
921    
922      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
923      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
924         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
925            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
926                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
                + falbe(i, is_ter) * pctsrf(i, is_ter) &  
                + falbe(i, is_sic) * pctsrf(i, is_sic)  
           albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &  
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
927         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
928         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
929              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
930              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
931              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
932              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
933              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
934      ENDIF      ENDIF
     itaprad = itaprad + 1  
935    
936      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
937      DO k = 1, llm      DO k = 1, llm
938         DO i = 1, klon         DO i = 1, klon
939            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
940                   / 86400.
941         ENDDO         ENDDO
942      ENDDO      ENDDO
943    
     IF (if_ebil >= 2) THEN  
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
     END IF  
   
944      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
945      DO i = 1, klon      zxqsurf = sum(fqsurf * pctsrf, dim = 2)
946         zxqsurf(i) = 0.      zxsnow = sum(fsnow * pctsrf, dim = 2)
        zxsnow(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! Calculer le bilan du sol et la dérive de température (couplage)  
947    
948        ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
949      DO i = 1, klon      DO i = 1, klon
950         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
951      ENDDO      ENDDO
952    
953      ! Paramétrisation de l'orographie à l'échelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
954    
955      IF (ok_orodr) THEN      IF (ok_orodr) THEN
956         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
957         igwd = 0         igwd = 0
958         DO i = 1, klon         DO i = 1, klon
959            itest(i) = 0            itest(i) = 0
960            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
961               itest(i) = 1               itest(i) = 1
962               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
963            ENDIF            ENDIF
964         ENDDO         ENDDO
965    
966         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
967              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
968              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
969    
970         ! ajout des tendances         ! ajout des tendances
971         DO k = 1, llm         DO k = 1, llm
# Line 1507  contains Line 978  contains
978      ENDIF      ENDIF
979    
980      IF (ok_orolf) THEN      IF (ok_orolf) THEN
981         ! Sélection des points pour lesquels le schéma est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
982         igwd = 0         igwd = 0
983         DO i = 1, klon         DO i = 1, klon
984            itest(i) = 0            itest(i) = 0
985            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
986               itest(i) = 1               itest(i) = 1
987               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
988            ENDIF            ENDIF
989         ENDDO         ENDDO
990    
# Line 1532  contains Line 1002  contains
1002         ENDDO         ENDDO
1003      ENDIF      ENDIF
1004    
1005      ! Stress nécessaires : toute la physique      ! Stress n\'ecessaires : toute la physique
1006    
1007      DO i = 1, klon      DO i = 1, klon
1008         zustrph(i) = 0.         zustrph(i) = 0.
# Line 1547  contains Line 1017  contains
1017         ENDDO         ENDDO
1018      ENDDO      ENDDO
1019    
1020      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1021           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
   
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &  
          2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &  
          d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
1022    
1023      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1024      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1025           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
1026           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1027           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           zmasse, ncid_startphy)
1028           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
1029        IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1030      IF (offline) THEN           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1031         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &           frac_impa, frac_nucl, pphis, airephy, dtphys)
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1032    
1033      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1034      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
1035    
1036      ! diag. bilKP      ! diag. bilKP
1037    
1038      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
1039           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1040    
1041      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1042    
1043      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1044      DO k = 1, llm      DO k = 1, llm
1045         DO i = 1, klon         DO i = 1, klon
1046            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1589  contains Line 1051  contains
1051         END DO         END DO
1052      END DO      END DO
1053    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
        ! Comme les tendances de la physique sont ajoute dans la dynamique,  
        ! on devrait avoir que la variation d'entalpie par la dynamique  
        ! est egale a la variation de la physique au pas de temps precedent.  
        ! Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &  
             evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
   
        d_h_vcol_phy = d_h_vcol  
   
     END IF  
   
1054      ! SORTIES      ! SORTIES
1055    
1056      ! prw = eau precipitable      ! prw = eau precipitable
1057      DO i = 1, klon      DO i = 1, klon
1058         prw(i) = 0.         prw(i) = 0.
1059         DO k = 1, llm         DO k = 1, llm
1060            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1061         ENDDO         ENDDO
1062      ENDDO      ENDDO
1063    
# Line 1628  contains Line 1073  contains
1073         ENDDO         ENDDO
1074      ENDDO      ENDDO
1075    
1076      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1077         DO iq = 3, nqmx         DO k = 1, llm
1078            DO k = 1, llm            DO i = 1, klon
1079               DO i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys  
              ENDDO  
1080            ENDDO            ENDDO
1081         ENDDO         ENDDO
1082      ENDIF      ENDDO
1083    
1084      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1085      DO k = 1, llm      DO k = 1, llm
# Line 1646  contains Line 1089  contains
1089         ENDDO         ENDDO
1090      ENDDO      ENDDO
1091    
1092      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1093      call write_histhf      CALL histwrite_phy("aire", airephy)
1094      call write_histday      CALL histwrite_phy("psol", paprs(:, 1))
1095      call write_histins      CALL histwrite_phy("precip", rain_fall + snow_fall)
1096        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1097      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("pluc", rain_con + snow_con)
1098      IF (lafin) THEN      CALL histwrite_phy("tsol", ztsol)
1099         itau_phy = itau_phy + itap      CALL histwrite_phy("t2m", zt2m)
1100         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("q2m", zq2m)
1101              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("u10m", zu10m)
1102              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &      CALL histwrite_phy("v10m", zv10m)
1103              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("snow", snow_fall)
1104              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      CALL histwrite_phy("cdrm", cdragm)
1105      ENDIF      CALL histwrite_phy("cdrh", cdragh)
1106        CALL histwrite_phy("topl", toplw)
1107      firstcal = .FALSE.      CALL histwrite_phy("evap", evap)
1108        CALL histwrite_phy("sols", solsw)
1109    contains      CALL histwrite_phy("soll", sollw)
1110        CALL histwrite_phy("solldown", sollwdown)
1111      subroutine write_histday      CALL histwrite_phy("bils", bils)
1112        CALL histwrite_phy("sens", - sens)
1113        use gr_phy_write_3d_m, only: gr_phy_write_3d      CALL histwrite_phy("fder", fder)
1114        integer itau_w ! pas de temps ecriture      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1115        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1116        !------------------------------------------------      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1117        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       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  
   
     !***************************************************************  
   
     subroutine write_histins  
   
       ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09  
   
       real zout  
       integer itau_w ! pas de temps ecriture  
   
       !--------------------------------------------------  
   
       IF (ok_instan) THEN  
          ! Champs 2D:  
   
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
          itau_w = itau_phy + itap  
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)  
          CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)  
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)  
          CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)  
1118    
1119           DO i = 1, klon      DO nsrf = 1, nbsrf
1120              zx_tmp_fi2d(i) = paprs(i, 1)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1121           ENDDO         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1122           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1123           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1124           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1125           DO i = 1, klon         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1126              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1127           ENDDO         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1128           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1129           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)      END DO
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)  
          !ccIM  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon) = -1*sens(1:klon)  
          ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
   
          DO nsrf = 1, nbsrf  
             !XXX  
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
          END DO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)  
   
          !HBTM2  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
   
          if (ok_sync) then  
             call histsync(nid_ins)  
          endif  
       ENDIF  
   
     end subroutine write_histins  
   
     !****************************************************  
   
     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  
1130    
1131        if (ok_sync) then      CALL histwrite_phy("albs", albsol)
1132           call histsync(nid_hf3d)      CALL histwrite_phy("rugs", zxrugs)
1133        endif      CALL histwrite_phy("s_pblh", s_pblh)
1134        CALL histwrite_phy("s_pblt", s_pblt)
1135        CALL histwrite_phy("s_lcl", s_lcl)
1136        CALL histwrite_phy("s_capCL", s_capCL)
1137        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1138        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1139        CALL histwrite_phy("s_therm", s_therm)
1140        CALL histwrite_phy("s_trmb1", s_trmb1)
1141        CALL histwrite_phy("s_trmb2", s_trmb2)
1142        CALL histwrite_phy("s_trmb3", s_trmb3)
1143    
1144        if (conv_emanuel) then
1145           CALL histwrite_phy("ptop", ema_pct)
1146           CALL histwrite_phy("dnwd0", - mp)
1147        end if
1148    
1149        CALL histwrite_phy("temp", t_seri)
1150        CALL histwrite_phy("vitu", u_seri)
1151        CALL histwrite_phy("vitv", v_seri)
1152        CALL histwrite_phy("geop", zphi)
1153        CALL histwrite_phy("pres", play)
1154        CALL histwrite_phy("dtvdf", d_t_vdf)
1155        CALL histwrite_phy("dqvdf", d_q_vdf)
1156        CALL histwrite_phy("rhum", zx_rh)
1157    
1158        if (ok_instan) call histsync(nid_ins)
1159    
1160        IF (lafin) then
1161           call NF95_CLOSE(ncid_startphy)
1162           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1163                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1164                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1165                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1166                w01)
1167        end IF
1168    
1169      end subroutine write_histhf3d      firstcal = .FALSE.
1170    
1171    END SUBROUTINE physiq    END SUBROUTINE physiq
1172    

Legend:
Removed from v.76  
changed lines
  Added in v.209

  ViewVC Help
Powered by ViewVC 1.1.21