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

Diff of /trunk/Sources/phylmd/physiq.f

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

revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC revision 214 by guez, Wed Mar 22 13:40:27 2017 UTC
# Line 16  contains Line 16  contains
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
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  
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 comconst, only: dtphys      use comconst, only: dtphys
27      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq      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
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
34      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
35      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
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 dynetat0_m, only: day_ref, annee_ref      use dynetat0_m, only: day_ref, annee_ref
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      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
43        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_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins, nid_ins
47        use netcdf95, only: NF95_CLOSE
48      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
49        use nr_util, only: assert
50        use nuage_m, only: nuage
51      USE orbite_m, ONLY: orbite      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 readsulfate_preind_m, only: readsulfate_preind      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61      use sugwd_m, only: sugwd      use time_phylmdz, only: itap, increment_itap
62      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use transp_m, only: transp
63      USE temps, ONLY: itau_phy      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      USE ymds2ju_m, ONLY: ymds2ju
66      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 78  contains Line 79  contains
79      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
80      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
81    
82      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
83      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
84    
85      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
86    
87      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
88      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
89    
90      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
92    
93      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95    
96      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)      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)      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)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100    
101      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 104  contains Line 105  contains
105    
106      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
107    
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust = .FALSE.)  
   
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
111      ! "slab" ocean      ! pour phystoke avec thermiques
     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  
   
     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)
# Line 137  contains Line 119  contains
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      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129      SAVE swdn0, swdn, swup0, swup  
130        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     ! 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.'/  
   
     ! ISCCP simulator v3.4  
   
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".
146    
147      REAL radsol(klon)      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
   
     INTEGER, SAVE:: itap ! number of calls to "physiq"  
   
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)
# Line 239  contains Line 152  contains
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
155    
156      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
157      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 259  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 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 290  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) ! fraction d'a\'erosols lessiv\'es (impaction)
210      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
211    
212      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
213      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
214    
215      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
216      ! solid water mass flux (kg/m2/s), positive down      ! 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, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
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
# Line 330  contains Line 235  contains
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
     REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE  
239      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
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        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
242    
243      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
244      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 354  contains Line 251  contains
251      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
252      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
253    
254      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
255      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
256      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
257      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)  
258    
259      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
260      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 375  contains Line 267  contains
267      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
268      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
269      REAL, save:: albpla(klon)      REAL, save:: albpla(klon)
270      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
271      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
272    
273      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
274      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
275    
276      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
277      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
278    
279      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
280    
281      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
282      real longi      real longi
283      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
284      REAL za, zb      REAL zb
285      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
286      real zqsat(klon, llm)      real zqsat(klon, llm)
287      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
288      REAL zphi(klon, llm)      REAL zphi(klon, llm)
289    
290      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
291    
292      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
293      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
294      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
295      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
296      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
297      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
298      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
299      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
300      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
301      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
302      ! Grdeurs de sorties      ! Grandeurs de sorties
303      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
304      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
305      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
306      REAL s_trmb3(klon)      REAL s_trmb3(klon)
307    
308      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
309    
310      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
311      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
312      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
313    
314      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
315    
# Line 432  contains Line 321  contains
321      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
322      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
323      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
324      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
325      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)
326      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
327      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 446  contains Line 335  contains
335      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
336    
337      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
338        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
339    
340      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
341      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
342        REAL, save:: snow_con(klon) ! neige (mm / s)
343        real snow_lsc(klon)
344      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
345    
346      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 472  contains Line 364  contains
364      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
365      logical ptconv(klon, llm)      logical ptconv(klon, llm)
366    
367      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
368    
369      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
370      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 486  contains Line 378  contains
378      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
379      REAL aam, torsfc      REAL aam, torsfc
380    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
381      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.
382      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.
383      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.
384      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.
385    
386      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
387      REAL ztsol(klon)      REAL ztsol(klon)
388      REAL d_h_vcol, d_qt, d_ec  
389      REAL, SAVE:: d_h_vcol_phy      REAL d_t_ec(klon, llm)
390      REAL zero_v(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
391      CHARACTER(LEN = 20) tit      ! énergie thermique
392      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
393      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
394        ! temperature and humidity at 2 m
395      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique  
396      REAL ZRCPD      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 t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m  
     REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/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 531  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 544  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/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
434           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
435           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
436    
437      !----------------------------------------------------------------      !----------------------------------------------------------------
438    
     IF (if_ebil >= 1) zero_v = 0.  
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 604  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 623  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         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
491              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
492              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
493              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &              w01, ncid_startphy)
             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    
        lmt_pas = day_step / iphysiq  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
498         radpas = lmt_pas / nbapp_rad         radpas = lmt_pas / nbapp_rad
499           print *, "radpas = ", radpas
        ! On remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
500    
501         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
502         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
503            ibas_con = 1            ibas_con = 1
504            itop_con = 1            itop_con = 1
505         ENDIF         ENDIF
# Line 656  contains Line 511  contains
511            rugoro = 0.            rugoro = 0.
512         ENDIF         ENDIF
513    
514         ecrit_ins = NINT(ecrit_ins/dtphys)         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)  
515    
516         ! Initialisation des sorties         ! Initialisation des sorties
517    
518         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys)
519         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)         CALL ymds2ju(annee_ref, 1, 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      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 677  contains Line 529  contains
529      v_seri = v      v_seri = v
530      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
531      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
532      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
533    
534      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
535    
     IF (if_ebil >= 1) THEN  
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajout\'es dans la  
        !  dynamique, la variation d'enthalpie par la dynamique devrait  
        !  \^etre \'egale \`a la variation de la physique au pas de temps  
        !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre  
        !  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.)  
     END IF  
   
536      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
537      IF (ancien_ok) THEN      IF (ancien_ok) THEN
538         DO k = 1, llm         DO k = 1, llm
# Line 723  contains Line 561  contains
561      ! Check temperatures:      ! Check temperatures:
562      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
563    
564      ! Incrémenter le compteur de la physique      call increment_itap
     itap = itap + 1  
565      julien = MOD(dayvrai, 360)      julien = MOD(dayvrai, 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
569    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
570      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
571      DO k = 1, llm      DO k = 1, llm
572         DO i = 1, klon         DO i = 1, klon
# Line 744  contains Line 578  contains
578      ENDDO      ENDDO
579      ql_seri = 0.      ql_seri = 0.
580    
     IF (if_ebil >= 2) THEN  
        tit = 'after reevap'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
     END IF  
   
581      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
582      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
583    
584      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
585      ! la surface.      ! la surface.
586    
587      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
588      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(longi, time, dtphys * radpas, mu0, fract)  
     ELSE  
        mu0 = -999.999  
     ENDIF  
589    
590      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
591      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
# Line 779  contains Line 601  contains
601    
602      fder = dlw      fder = dlw
603    
604      ! Couche limite:      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
605             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
606      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
607           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &           snow_fall, fsolsw, fsollw, fder, frugs, agesno, rugoro, d_t_vdf, &
608           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
609           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &           cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, &
610           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, &
611           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &           plcl, fqcalving, ffonte, run_off_lic_0)
          ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &  
          pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &  
          run_off_lic_0, fluxo, fluxg, tslab)  
612    
613      ! Incr\'ementation des flux      ! Incr\'ementation des flux
614    
615      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
616      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
617      zxfluxu = 0.      fder = dlw + dsens + devap
     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'\'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
618    
619      DO k = 1, llm      DO k = 1, llm
620         DO i = 1, klon         DO i = 1, klon
# Line 822  contains Line 625  contains
625         ENDDO         ENDDO
626      ENDDO      ENDDO
627    
     IF (if_ebil >= 2) THEN  
        tit = 'after clmain'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
     END IF  
   
628      ! Update surface temperature:      ! Update surface temperature:
629    
630      DO i = 1, klon      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
631         zxtsol(i) = 0.      ftsol = ftsol + d_ts
632         zxfluxlat(i) = 0.      ztsol = sum(ftsol * pctsrf, dim = 2)
633        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
634         zt2m(i) = 0.      zt2m = sum(t2m * pctsrf, dim = 2)
635         zq2m(i) = 0.      zq2m = sum(q2m * pctsrf, dim = 2)
636         zu10m(i) = 0.      zu10m = sum(u10m * pctsrf, dim = 2)
637         zv10m(i) = 0.      zv10m = sum(v10m * pctsrf, dim = 2)
638         zxffonte(i) = 0.      zxffonte = sum(ffonte * pctsrf, dim = 2)
639         zxfqcalving(i) = 0.      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
640        s_pblh = sum(pblh * pctsrf, dim = 2)
641         s_pblh(i) = 0.      s_lcl = sum(plcl * pctsrf, dim = 2)
642         s_lcl(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
643         s_capCL(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
644         s_oliqCL(i) = 0.      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
645         s_cteiCL(i) = 0.      s_pblT = sum(pblT * pctsrf, dim = 2)
646         s_pblT(i) = 0.      s_therm = sum(therm * pctsrf, dim = 2)
647         s_therm(i) = 0.      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
648         s_trmb1(i) = 0.      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
649         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\`eme 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  
650    
651      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
652      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
653         DO i = 1, klon         DO i = 1, klon
654            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
655                 ftsol(i, nsrf) = ztsol(i)
656            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
657            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
658            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
659            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
660            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
661            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
662                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
663            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
664            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
665            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
666            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
667            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
668            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
669            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
670            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
671            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
672            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
673         ENDDO         ENDDO
674      ENDDO      ENDDO
675    
676      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
677    
678      DO i = 1, klon      DO i = 1, klon
679         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
680      ENDDO      ENDDO
681    
682      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      ! Appeler la convection
   
     ! Appeler la convection (au choix)  
   
     if (iflag_con == 2) then  
        conv_q = d_q_dyn + d_q_vdf / dtphys  
        conv_t = d_t_dyn + d_t_vdf / dtphys  
        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  
683    
684         da = 0.      if (conv_emanuel) then
685         mp = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
686         phi = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
687         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
688              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &         snow_con = 0.
             ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &  
             qcondc, wd, pmflxr, pmflxs, da, phi, mp)  
689         clwcon0 = qcondc         clwcon0 = qcondc
690         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
691    
692         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
693            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)         zqsat = zqsat / (1. - retv * zqsat)
           zqsat = zqsat / (1. - retv * zqsat)  
        ELSE  
           zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play  
        ENDIF  
694    
695         ! Properties of convective clouds         ! Properties of convective clouds
696         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
697         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
698              rnebcon0)              rnebcon0)
699    
700           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
701         mfd = 0.         mfd = 0.
702         pen_u = 0.         pen_u = 0.
703         pen_d = 0.         pen_d = 0.
704         pde_d = 0.         pde_d = 0.
705         pde_u = 0.         pde_u = 0.
706        else
707           conv_q = d_q_dyn + d_q_vdf / dtphys
708           conv_t = d_t_dyn + d_t_vdf / dtphys
709           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
710           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
711                q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
712                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
713                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
714                kdtop, pmflxr, pmflxs)
715           WHERE (rain_con < 0.) rain_con = 0.
716           WHERE (snow_con < 0.) snow_con = 0.
717           ibas_con = llm + 1 - kcbot
718           itop_con = llm + 1 - kctop
719      END if      END if
720    
721      DO k = 1, llm      DO k = 1, llm
# Line 975  contains Line 727  contains
727         ENDDO         ENDDO
728      ENDDO      ENDDO
729    
730      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, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        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  
731         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
732         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
733         DO k = 1, llm         DO k = 1, llm
# Line 1024  contains Line 754  contains
754         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
755         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
756      else      else
        ! Thermiques  
757         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
758              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)
759      endif      endif
760    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
     END IF  
   
761      ! Caclul des ratqs      ! Caclul des ratqs
762    
763      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
# Line 1056  contains Line 779  contains
779      do k = 1, llm      do k = 1, llm
780         do i = 1, klon         do i = 1, klon
781            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
782                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
783         enddo         enddo
784      enddo      enddo
785    
# Line 1089  contains Line 812  contains
812            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
813         ENDDO         ENDDO
814      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        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, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
     END IF  
815    
816      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
817    
818      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
819    
820      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
821         ! seulement pour Tiedtke         ! seulement pour Tiedtke
822         snow_tiedtke = 0.         snow_tiedtke = 0.
823         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
824            rain_tiedtke = rain_con            rain_tiedtke = rain_con
825         else         else
826            rain_tiedtke = 0.            rain_tiedtke = 0.
827            do k = 1, llm            do k = 1, llm
828               do i = 1, klon               do i = 1, klon
829                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
830                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
831                          *zmasse(i, k)                          * zmasse(i, k)
832                  endif                  endif
833               enddo               enddo
834            enddo            enddo
# Line 1161  contains Line 863  contains
863    
864         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
865         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
866         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
867      ENDIF      ENDIF
868    
869      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1184  contains Line 886  contains
886         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
887      ENDDO      ENDDO
888    
     IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &  
          dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
   
889      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
890      DO k = 1, llm      DO k = 1, llm
891         DO i = 1, klon         DO i = 1, klon
892            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
893            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
894               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zx_qs = MIN(0.5, zx_qs)
895               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
896               zcor = 1./(1.-retv*zx_qs)            zx_qs = zx_qs * zcor
897               zx_qs = zx_qs*zcor            zx_rh(i, k) = q_seri(i, k) / zx_qs
           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  
898            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
899         ENDDO         ENDDO
900      ENDDO      ENDDO
901    
902      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
903      IF (ok_ade .OR. ok_aie) THEN      tau_ae = 0.
904         ! Get sulfate aerosol distribution :      piz_ae = 0.
905         CALL readsulfate(dayvrai, time, firstcal, sulfate)      cg_ae = 0.
        CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)  
   
        CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &  
             aerindex)  
     ELSE  
        tau_ae = 0.  
        piz_ae = 0.  
        cg_ae = 0.  
     ENDIF  
906    
907      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
908      ! diagnostics :      ! diagnostics :
# Line 1236  contains Line 917  contains
917      endif      endif
918    
919      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
920           ! Prescrire l'ozone :
921           wo = ozonecm(REAL(julien), paprs)
922    
923         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
924         ! Calcul de l'abedo moyen par maille         ! Calcul de l'abedo moyen par maille
925         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
926    
927         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
928         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
929              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
930              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
931              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1250  contains Line 934  contains
934      ENDIF      ENDIF
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, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
     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  
947    
948      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)      ! 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
# Line 1286  contains Line 953  contains
953      ! Param\'etrisation de l'orographie \`a l'\'echelle 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    
# Line 1316  contains Line 982  contains
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 1352  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, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
1022    
1023      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1024      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1025           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
1026           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1027           upwd, dnwd, tr_seri, zmasse)           zmasse, ncid_startphy)
1028    
1029      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1030           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1031           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           frac_impa, frac_nucl, pphis, airephy, dtphys)
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))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
           d_t_ec(i, k) = 0.5 / ZRCPD &  
1047                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
1048            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
1049            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1050         END DO         END DO
1051      END DO      END DO
1052    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, 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)  
        d_h_vcol_phy = d_h_vcol  
     END IF  
   
1053      ! SORTIES      ! SORTIES
1054    
1055      ! prw = eau precipitable      ! prw = eau precipitable
1056      DO i = 1, klon      DO i = 1, klon
1057         prw(i) = 0.         prw(i) = 0.
1058         DO k = 1, llm         DO k = 1, llm
1059            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1060         ENDDO         ENDDO
1061      ENDDO      ENDDO
1062    
# Line 1429  contains Line 1075  contains
1075      DO iq = 3, nqmx      DO iq = 3, nqmx
1076         DO k = 1, llm         DO k = 1, llm
1077            DO i = 1, klon            DO i = 1, klon
1078               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
1079            ENDDO            ENDDO
1080         ENDDO         ENDDO
1081      ENDDO      ENDDO
# Line 1442  contains Line 1088  contains
1088         ENDDO         ENDDO
1089      ENDDO      ENDDO
1090    
1091      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1092      call write_histins      CALL histwrite_phy("aire", airephy)
1093        CALL histwrite_phy("psol", paprs(:, 1))
1094      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("precip", rain_fall + snow_fall)
1095      IF (lafin) THEN      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1096         itau_phy = itau_phy + itap      CALL histwrite_phy("pluc", rain_con + snow_con)
1097         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &      CALL histwrite_phy("tsol", ztsol)
1098              fqsurf, qsol, fsnow, falbe, fevap, rain_fall, snow_fall, &      CALL histwrite_phy("t2m", zt2m)
1099              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &      CALL histwrite_phy("q2m", zq2m)
1100              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &      CALL histwrite_phy("u10m", zu10m)
1101              run_off_lic_0, sig1, w01)      CALL histwrite_phy("v10m", zv10m)
1102      ENDIF      CALL histwrite_phy("snow", snow_fall)
1103        CALL histwrite_phy("cdrm", cdragm)
1104      firstcal = .FALSE.      CALL histwrite_phy("cdrh", cdragh)
1105        CALL histwrite_phy("topl", toplw)
1106    contains      CALL histwrite_phy("evap", evap)
1107        CALL histwrite_phy("sols", solsw)
1108      subroutine write_histins      CALL histwrite_phy("soll", sollw)
1109        CALL histwrite_phy("solldown", sollwdown)
1110        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09      CALL histwrite_phy("bils", bils)
1111        CALL histwrite_phy("sens", - sens)
1112        use dimens_m, only: iim, jjm      CALL histwrite_phy("fder", fder)
1113        USE histsync_m, ONLY: histsync      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1114        USE histwrite_m, ONLY: histwrite      CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1115        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1116        integer i, itau_w ! pas de temps ecriture      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
       !--------------------------------------------------  
   
       IF (ok_instan) THEN  
          ! Champs 2D:  
   
          itau_w = itau_phy + itap  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)  
          CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)  
          CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = paprs(i, 1)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)  
   
          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)  
1117    
1118           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)      DO nsrf = 1, nbsrf
1119           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1120           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1121           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1122           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1123           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1124           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1125           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1126           CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1127           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1128           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)      END DO
   
          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(:, 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, 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)  
1129    
1130           call histsync(nid_ins)      CALL histwrite_phy("albs", albsol)
1131        ENDIF      CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1132        CALL histwrite_phy("rugs", zxrugs)
1133        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        CALL histwrite_phy("d_t_ec", d_t_ec)
1158        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1159        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1160    
1161        if (ok_instan) call histsync(nid_ins)
1162    
1163        IF (lafin) then
1164           call NF95_CLOSE(ncid_startphy)
1165           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1166                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1167                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1168                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1169                w01)
1170        end IF
1171    
1172      end subroutine write_histins      firstcal = .FALSE.
1173    
1174    END SUBROUTINE physiq    END SUBROUTINE physiq
1175    
Legend:
Removed from v.155  
changed lines
  Added in v.214
  ViewVC Help
Powered by ViewVC 1.1.21