/[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

trunk/phylmd/physiq.f revision 103 by guez, Fri Aug 29 13:00:05 2014 UTC trunk/Sources/phylmd/physiq.f revision 205 by guez, Tue Jun 21 15:16:03 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)         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
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: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &
24           ok_orodr, ok_orolf           ok_orodr, ok_orolf
25      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
26      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
27      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
28        USE comgeomphy, ONLY: airephy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, day_step, iphysiq, lmt_pas
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32      use conflx_m, only: conflx      use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
35      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
36      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39        use dynetat0_m, only: day_ref, annee_ref
40      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
41      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
42      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
43        USE histsync_m, ONLY: histsync
44        USE histwrite_phy_m, ONLY: histwrite_phy
45      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, &
46           nbsrf           nbsrf
47      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins, nid_ins
48        use netcdf95, only: NF95_CLOSE
49      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
50        use nr_util, only: assert
51        use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56        USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
59      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
60      use readsulfate_m, only: readsulfate      use yoegwd, only: sugwd
61      use sugwd_m, only: sugwd      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use time_phylmdz, only: itap, increment_itap
63      USE temps, ONLY: annee_ref, day_ref, itau_phy      use transp_m, only: transp
64        use transp_lay_m, only: transp_lay
65      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
66      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
67      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 64  contains Line 69  contains
69    
70      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
71    
72      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
73      ! (elapsed time since January 1st 0h of the starting year, in days)      ! current day number, based at value 1 on January 1st of annee_ref
74    
75      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
76    
77      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
78      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 76  contains Line 80  contains
80      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
81      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
82    
83      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
84      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
85    
86      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
87    
88      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
89      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
90    
91      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
92      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
93    
94      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
95      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
96    
97      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
98      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)
99      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)
100      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)
101    
102      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
103      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 102  contains Line 106  contains
106    
107      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
108    
     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  
   
109      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
111    
112      ! "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  
113      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
114      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
115      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 135  contains Line 120  contains
120      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
121      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
122    
123      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
124      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)
125    
126      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
127    
128      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
129      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
130      SAVE swdn0, swdn, swup0, swup  
131        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
132      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 '/  
133    
134      ! prw: precipitable water      ! prw: precipitable water
135      real prw(klon)      real prw(klon)
136    
137      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
138      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
139      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
140      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
141    
     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  
   
142      ! Variables propres a la physique      ! Variables propres a la physique
143    
144      INTEGER, save:: radpas      INTEGER, save:: radpas
145      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
146      ! "physiq".)      ! "physiq".
   
     REAL radsol(klon)  
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
147    
148      INTEGER, SAVE:: itap ! number of calls to "physiq"      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
149    
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
151    
# Line 236  contains Line 153  contains
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
156      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
157    
158      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 246  contains Line 162  contains
162      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
163    
164      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
165      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface  
166    
167      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
168      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 258  contains Line 173  contains
173      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
174      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
175      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
176      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
177        INTEGER igwd, itest(klon)
178    
179      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
180        REAL, save:: run_off_lic_0(klon)
     REAL agesno(klon, nbsrf)  
     SAVE agesno ! age de la neige  
181    
182      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
183      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
184      !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  
185      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:  
186    
187        ! Variables pour la couche limite (Alain Lahellec) :
188      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
189      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
190    
# Line 289  contains Line 192  contains
192      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
193      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
194      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
195      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
196      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL, save:: ffonte(klon, nbsrf)
197      ! !et necessaire pour limiter la      ! flux thermique utilise pour fondre la neige
198      ! !hauteur de neige, en kg/m2/s  
199        REAL, save:: fqcalving(klon, nbsrf)
200        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
201        ! hauteur de neige, en kg / m2 / s
202    
203      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
206      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
207      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
208      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
209      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
210      save pfrac_1nucl  
211      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
212      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
213    
214      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
215      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
216    
217      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
218      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
219    
220      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
221    
222      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon), devap(klon) ! evaporation and its derivative
223      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
224      REAL dlw(klon) ! derivee infra rouge      REAL, save:: dlw(klon) ! derivee infra rouge
     SAVE dlw  
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
# 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
239      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total visible
     REAL, save:: albsol(klon) ! albedo du sol total  
     REAL, save:: albsollw(klon) ! 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 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 368  contains Line 263  contains
263      ! 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
264      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
265      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
266      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
267      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
268      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
269      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
270      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
271      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
272      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
273      REAL albpla(klon)      REAL, save:: albpla(klon)
274      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
275      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
     SAVE albpla  
     SAVE heat0, cool0  
276    
277      INTEGER itaprad      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
278      SAVE itaprad      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
279    
280      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
281      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
282    
283      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
     REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree  
284    
285      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL dist, mu0(klon), fract(klon)
286        real longi
     REAL dist, rmu0(klon), fract(klon)  
     real zlongi  
287      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
288      REAL za, zb      REAL zb
289      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
290      real zqsat(klon, llm)      real zqsat(klon, llm)
291      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
292      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
293      REAL zphi(klon, llm)      REAL zphi(klon, llm)
294    
295      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
296    
297      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
298      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 412  contains Line 302  contains
302      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
303      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
304      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
305      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
306      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
307      ! Grdeurs de sorties      ! Grandeurs de sorties
308      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
309      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
310      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
311      REAL s_trmb3(klon)      REAL s_trmb3(klon)
312    
313      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
314    
315      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
316      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
317      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
318      REAL cape(klon) ! CAPE      REAL, save:: cape(klon)
     SAVE cape  
319    
320      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
321    
# Line 438  contains Line 327  contains
327      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
328      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
329      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
330      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
331      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)
332      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
333      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 452  contains Line 341  contains
341      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
342    
343      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
344        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
345    
346      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
347      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
348        REAL, save:: snow_con(klon) ! neige (mm / s)
349        real snow_lsc(klon)
350      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
351    
352      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 478  contains Line 370  contains
370      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
371      logical ptconv(klon, llm)      logical ptconv(klon, llm)
372    
373      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
374    
375      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
376      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 492  contains Line 384  contains
384      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
385      REAL aam, torsfc      REAL aam, torsfc
386    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
387      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.
388      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.
389      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.
390      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.
391    
     REAL zsto  
392      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
393      REAL ztsol(klon)      REAL ztsol(klon)
     REAL d_h_vcol, d_qt, d_ec  
     REAL, SAVE:: d_h_vcol_phy  
     REAL zero_v(klon)  
     CHARACTER(LEN = 20) tit  
     INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
     INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation  
394    
395      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      REAL d_t_ec(klon, llm)
396        ! tendance due \`a la conversion Ec en énergie thermique
397    
398      REAL ZRCPD      REAL ZRCPD
399    
400      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
401      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
402    
403        REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
404      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
405      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
406    
407      ! Aerosol effects:      ! Aerosol effects:
408    
409      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g / m3)
410    
411      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
412      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g / m3, pre-industrial value
413    
414      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
415      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial aerosols
416    
417      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
418      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 538  contains Line 421  contains
421      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
422      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
423    
424      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
425      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
   
     REAL aerindex(klon) ! POLDER aerosol index  
426    
427      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
428      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 551  contains Line 432  contains
432      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
433      ! concentration.      ! concentration.
434    
435      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)  
436      ! (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)
437    
438      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
439    
440      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
441           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
442           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
443    
444      !----------------------------------------------------------------      !----------------------------------------------------------------
445    
     IF (if_ebil >= 1) zero_v = 0.  
446      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
447           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
448    
449      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
450         ! initialiser         ! initialiser
# Line 614  contains Line 479  contains
479         pblt =0. ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
480         therm =0.         therm =0.
481         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
482         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
483         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
484    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
485         iflag_thermals = 0         iflag_thermals = 0
486         nsplit_thermals = 1         nsplit_thermals = 1
487         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 630  contains Line 493  contains
493         ! Initialiser les compteurs:         ! Initialiser les compteurs:
494    
495         frugs = 0.         frugs = 0.
496         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
497         itaprad = 0              fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
498         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
499              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
500              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              w01, ncid_startphy)
             zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0, sig1, w01)  
501    
502         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
503         q2 = 1e-8         q2 = 1e-8
504    
505         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = lmt_pas / nbapp_rad
506           print *, "radpas = ", radpas
        ! on remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        PRINT *, 'cycle_diurne = ', cycle_diurne  
        CALL printflag(radpas, ok_journe, 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  
507    
508         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
509         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
510            ibas_con = 1            ibas_con = 1
511            itop_con = 1            itop_con = 1
512         ENDIF         ENDIF
# Line 668  contains Line 518  contains
518            rugoro = 0.            rugoro = 0.
519         ENDIF         ENDIF
520    
521         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)  
522    
523         ! Initialisation des sorties         ! Initialisation des sorties
524    
525         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys)
526         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
527         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
528         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
529           CALL phyredem0
530      ENDIF test_firstcal      ENDIF test_firstcal
531    
532      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 692  contains Line 536  contains
536      v_seri = v      v_seri = v
537      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
538      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
539      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
540    
541      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
542    
     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  
   
543      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
544      IF (ancien_ok) THEN      IF (ancien_ok) THEN
545         DO k = 1, llm         DO k = 1, llm
# Line 738  contains Line 568  contains
568      ! Check temperatures:      ! Check temperatures:
569      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
570    
571      ! Incrémenter le compteur de la physique      call increment_itap
572      itap = itap + 1      julien = MOD(dayvrai, 360)
     julien = MOD(NINT(rdayvrai), 360)  
573      if (julien == 0) julien = 360      if (julien == 0) julien = 360
574    
575      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
# Line 759  contains Line 588  contains
588      ENDDO      ENDDO
589      ql_seri = 0.      ql_seri = 0.
590    
     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  
   
591      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
592      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
593    
594      ! Calculs nécessaires au calcul de l'albedo dans l'interface      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
595        ! la surface.
596    
597      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
598      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
599         CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
600      ELSE      ELSE
601         rmu0 = -999.999         mu0 = - 999.999
602      ENDIF      ENDIF
603    
604      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
605      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw = sum(falblw * pctsrf, dim = 2)  
606    
607      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
608      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
# Line 796  contains Line 617  contains
617    
618      ! Couche limite:      ! Couche limite:
619    
620      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
621           v_seri, julien, rmu0, co2_ppm, ftsol, cdmmax, cdhmax, &           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
622           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
623           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &
624           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &
625           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
626           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
627           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
          fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)  
628    
629      ! Incr\'ementation des flux      ! Incr\'ementation des flux
630    
# Line 837  contains Line 657  contains
657         ENDDO         ENDDO
658      ENDDO      ENDDO
659    
     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  
   
660      ! Update surface temperature:      ! Update surface temperature:
661    
662      DO i = 1, klon      DO i = 1, klon
        zxtsol(i) = 0.  
663         zxfluxlat(i) = 0.         zxfluxlat(i) = 0.
664    
665         zt2m(i) = 0.         zt2m(i) = 0.
# Line 858  contains Line 669  contains
669         zxffonte(i) = 0.         zxffonte(i) = 0.
670         zxfqcalving(i) = 0.         zxfqcalving(i) = 0.
671    
672         s_pblh(i) = 0.         s_pblh(i) = 0.
673         s_lcl(i) = 0.         s_lcl(i) = 0.
674         s_capCL(i) = 0.         s_capCL(i) = 0.
675         s_oliqCL(i) = 0.         s_oliqCL(i) = 0.
676         s_cteiCL(i) = 0.         s_cteiCL(i) = 0.
# Line 868  contains Line 679  contains
679         s_trmb1(i) = 0.         s_trmb1(i) = 0.
680         s_trmb2(i) = 0.         s_trmb2(i) = 0.
681         s_trmb3(i) = 0.         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)  
682      ENDDO      ENDDO
683    
684        call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
685    
686        ftsol = ftsol + d_ts
687        ztsol = sum(ftsol * pctsrf, dim = 2)
688      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
689         DO i = 1, klon         DO i = 1, klon
690            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)
691            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
692            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)            zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)
693              zq2m(i) = zq2m(i) + q2m(i, nsrf) * pctsrf(i, nsrf)
694            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf) * pctsrf(i, nsrf)
695            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf) * pctsrf(i, nsrf)
696            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(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)  
697            zxfqcalving(i) = zxfqcalving(i) + &            zxfqcalving(i) = zxfqcalving(i) + &
698                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf) * pctsrf(i, nsrf)
699            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf) * pctsrf(i, nsrf)
700            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf) * pctsrf(i, nsrf)
701            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) * pctsrf(i, nsrf)
702            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) * pctsrf(i, nsrf)
703            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) * pctsrf(i, nsrf)
704            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) * pctsrf(i, nsrf)
705            s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)            s_therm(i) = s_therm(i) + therm(i, nsrf) * pctsrf(i, nsrf)
706            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)            s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) * pctsrf(i, nsrf)
707            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)            s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) * pctsrf(i, nsrf)
708            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)            s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) * pctsrf(i, nsrf)
709         ENDDO         ENDDO
710      ENDDO      ENDDO
711    
712      ! 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 :
713      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
714         DO i = 1, klon         DO i = 1, klon
715            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
716                 ftsol(i, nsrf) = ztsol(i)
717            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
718            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
719            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
720            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
721            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
722            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
723                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
724            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
725            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
726            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
727            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
728            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
729            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
730            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
731            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
732            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
733            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
734         ENDDO         ENDDO
735      ENDDO      ENDDO
736    
737      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
738    
739      DO i = 1, klon      DO i = 1, klon
740         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
741      ENDDO      ENDDO
742    
743      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  
744    
745         da = 0.      if (conv_emanuel) then
746         mp = 0.         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
747         phi = 0.              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
748         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
749              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)  
750         clwcon0 = qcondc         clwcon0 = qcondc
751         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
752    
753         IF (thermcep) THEN         IF (thermcep) THEN
754            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
# Line 974  contains Line 762  contains
762         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
763              rnebcon0)              rnebcon0)
764    
765           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
766         mfd = 0.         mfd = 0.
767         pen_u = 0.         pen_u = 0.
768         pen_d = 0.         pen_d = 0.
769         pde_d = 0.         pde_d = 0.
770         pde_u = 0.         pde_u = 0.
771        else
772           conv_q = d_q_dyn + d_q_vdf / dtphys
773           conv_t = d_t_dyn + d_t_vdf / dtphys
774           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
775           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
776                q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &
777                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
778                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
779                kdtop, pmflxr, pmflxs)
780           WHERE (rain_con < 0.) rain_con = 0.
781           WHERE (snow_con < 0.) snow_con = 0.
782           ibas_con = llm + 1 - kcbot
783           itop_con = llm + 1 - kctop
784      END if      END if
785    
786      DO k = 1, llm      DO k = 1, llm
# Line 990  contains Line 792  contains
792         ENDDO         ENDDO
793      ENDDO      ENDDO
794    
795      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  
796         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
797         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
798         DO k = 1, llm         DO k = 1, llm
# Line 1039  contains Line 819  contains
819         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
820         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
821      else      else
        ! Thermiques  
822         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
823              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)
824      endif      endif
825    
     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  
   
826      ! Caclul des ratqs      ! Caclul des ratqs
827    
828      ! 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 1071  contains Line 844  contains
844      do k = 1, llm      do k = 1, llm
845         do i = 1, klon         do i = 1, klon
846            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
847                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
848         enddo         enddo
849      enddo      enddo
850    
# Line 1104  contains Line 877  contains
877            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
878         ENDDO         ENDDO
879      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  
880    
881      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
882    
883      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
884    
885      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
886         ! seulement pour Tiedtke         ! seulement pour Tiedtke
887         snow_tiedtke = 0.         snow_tiedtke = 0.
888         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
889            rain_tiedtke = rain_con            rain_tiedtke = rain_con
890         else         else
891            rain_tiedtke = 0.            rain_tiedtke = 0.
892            do k = 1, llm            do k = 1, llm
893               do i = 1, klon               do i = 1, klon
894                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
895                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
896                          *zmasse(i, k)                          * zmasse(i, k)
897                  endif                  endif
898               enddo               enddo
899            enddo            enddo
# Line 1176  contains Line 928  contains
928    
929         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
930         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
931         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
932      ENDIF      ENDIF
933    
934      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1199  contains Line 951  contains
951         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
952      ENDDO      ENDDO
953    
     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)  
   
954      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
955      DO k = 1, llm      DO k = 1, llm
956         DO i = 1, klon         DO i = 1, klon
957            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
958            IF (thermcep) THEN            IF (thermcep) THEN
959               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
960               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
961               zcor = 1./(1.-retv*zx_qs)               zcor = 1. / (1. - retv * zx_qs)
962               zx_qs = zx_qs*zcor               zx_qs = zx_qs * zcor
963            ELSE            ELSE
964               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
965                  zx_qs = qsats(zx_t)/play(i, k)                  zx_qs = qsats(zx_t) / play(i, k)
966               ELSE               ELSE
967                  zx_qs = qsatl(zx_t)/play(i, k)                  zx_qs = qsatl(zx_t) / play(i, k)
968               ENDIF               ENDIF
969            ENDIF            ENDIF
970            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
971            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
972         ENDDO         ENDDO
973      ENDDO      ENDDO
974    
975      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
976      IF (ok_ade .OR. ok_aie) THEN      tau_ae = 0.
977         ! Get sulfate aerosol distribution :      piz_ae = 0.
978         CALL readsulfate(rdayvrai, firstcal, sulfate)      cg_ae = 0.
        CALL readsulfate_preind(rdayvrai, 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  
979    
980      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
981      ! diagnostics :      ! diagnostics :
# Line 1250  contains Line 989  contains
989              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
990      endif      endif
991    
992      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
993      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
994         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
995            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
996                 + 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  
997         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
998         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
999              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1000              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1001              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
1002              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, &
1003              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1004      ENDIF      ENDIF
     itaprad = itaprad + 1  
1005    
1006      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1007    
1008      DO k = 1, llm      DO k = 1, llm
1009         DO i = 1, klon         DO i = 1, klon
1010            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 &
1011                   / 86400.
1012         ENDDO         ENDDO
1013      ENDDO      ENDDO
1014    
     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  
   
1015      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1016      DO i = 1, klon      DO i = 1, klon
1017         zxqsurf(i) = 0.         zxqsurf(i) = 0.
# Line 1296  contains Line 1019  contains
1019      ENDDO      ENDDO
1020      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1021         DO i = 1, klon         DO i = 1, klon
1022            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)            zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf) * pctsrf(i, nsrf)
1023            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)            zxsnow(i) = zxsnow(i) + fsnow(i, nsrf) * pctsrf(i, nsrf)
1024         ENDDO         ENDDO
1025      ENDDO      ENDDO
1026    
# Line 1310  contains Line 1033  contains
1033      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1034    
1035      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1036         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1037         igwd = 0         igwd = 0
1038         DO i = 1, klon         DO i = 1, klon
1039            itest(i) = 0            itest(i) = 0
1040            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1041               itest(i) = 1               itest(i) = 1
1042               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1043            ENDIF            ENDIF
1044         ENDDO         ENDDO
1045    
1046         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1047              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1048              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1049    
1050         ! ajout des tendances         ! ajout des tendances
1051         DO k = 1, llm         DO k = 1, llm
# Line 1340  contains Line 1062  contains
1062         igwd = 0         igwd = 0
1063         DO i = 1, klon         DO i = 1, klon
1064            itest(i) = 0            itest(i) = 0
1065            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1066               itest(i) = 1               itest(i) = 1
1067               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1068            ENDIF            ENDIF
1069         ENDDO         ENDDO
1070    
# Line 1376  contains Line 1097  contains
1097         ENDDO         ENDDO
1098      ENDDO      ENDDO
1099    
1100      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1101           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)  
1102    
1103      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1104      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1105           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, &
1106           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
1107           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &           zmasse, ncid_startphy)
1108           mp, upwd, dnwd, tr_seri, zmasse)  
1109        IF (offline) call phystokenc(dtphys, t, mfu, mfd, pen_u, pde_u, pen_d, &
1110      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &           pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, pctsrf, &
1111           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           frac_impa, frac_nucl, pphis, airephy, dtphys)
          pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
1112    
1113      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1114      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)  
1115    
1116      ! diag. bilKP      ! diag. bilKP
1117    
1118      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, &
1119           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1120    
1121      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1122    
1123      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
1124      DO k = 1, llm      DO k = 1, llm
1125         DO i = 1, klon         DO i = 1, klon
1126            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
# Line 1416  contains Line 1131  contains
1131         END DO         END DO
1132      END DO      END DO
1133    
     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  
   
1134      ! SORTIES      ! SORTIES
1135    
1136      ! prw = eau precipitable      ! prw = eau precipitable
1137      DO i = 1, klon      DO i = 1, klon
1138         prw(i) = 0.         prw(i) = 0.
1139         DO k = 1, llm         DO k = 1, llm
1140            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1141         ENDDO         ENDDO
1142      ENDDO      ENDDO
1143    
# Line 1454  contains Line 1156  contains
1156      DO iq = 3, nqmx      DO iq = 3, nqmx
1157         DO k = 1, llm         DO k = 1, llm
1158            DO i = 1, klon            DO i = 1, klon
1159               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
1160            ENDDO            ENDDO
1161         ENDDO         ENDDO
1162      ENDDO      ENDDO
# Line 1467  contains Line 1169  contains
1169         ENDDO         ENDDO
1170      ENDDO      ENDDO
1171    
1172      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1173      call write_histins      CALL histwrite_phy("aire", airephy)
1174        CALL histwrite_phy("psol", paprs(:, 1))
1175      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("precip", rain_fall + snow_fall)
1176      IF (lafin) THEN      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1177         itau_phy = itau_phy + itap      CALL histwrite_phy("pluc", rain_con + snow_con)
1178         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("tsol", ztsol)
1179              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("t2m", zt2m)
1180              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &      CALL histwrite_phy("q2m", zq2m)
1181              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("u10m", zu10m)
1182              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      CALL histwrite_phy("v10m", zv10m)
1183      ENDIF      CALL histwrite_phy("snow", snow_fall)
1184        CALL histwrite_phy("cdrm", cdragm)
1185      firstcal = .FALSE.      CALL histwrite_phy("cdrh", cdragh)
1186        CALL histwrite_phy("topl", toplw)
1187    contains      CALL histwrite_phy("evap", evap)
1188        CALL histwrite_phy("sols", solsw)
1189      subroutine write_histins      CALL histwrite_phy("soll", sollw)
1190        CALL histwrite_phy("solldown", sollwdown)
1191        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09      CALL histwrite_phy("bils", bils)
1192        CALL histwrite_phy("sens", - sens)
1193        use dimens_m, only: iim, jjm      CALL histwrite_phy("fder", fder)
1194        USE histsync_m, ONLY: histsync      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1195        USE histwrite_m, ONLY: histwrite      CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1196        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1197        real zout      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       integer itau_w ! pas de temps ecriture  
       REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
       !--------------------------------------------------  
   
       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)  
   
          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)  
   
          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)  
1198    
1199           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)      DO nsrf = 1, nbsrf
1200           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1201           CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1202           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))
1203           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1204           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1205           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))
1206           CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))
1207           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1208           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1209        END DO
          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)  
1210    
1211           call histsync(nid_ins)      CALL histwrite_phy("albs", albsol)
1212        ENDIF      CALL histwrite_phy("rugs", zxrugs)
1213        CALL histwrite_phy("s_pblh", s_pblh)
1214        CALL histwrite_phy("s_pblt", s_pblt)
1215        CALL histwrite_phy("s_lcl", s_lcl)
1216        CALL histwrite_phy("s_capCL", s_capCL)
1217        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1218        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1219        CALL histwrite_phy("s_therm", s_therm)
1220        CALL histwrite_phy("s_trmb1", s_trmb1)
1221        CALL histwrite_phy("s_trmb2", s_trmb2)
1222        CALL histwrite_phy("s_trmb3", s_trmb3)
1223        if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)
1224        CALL histwrite_phy("temp", t_seri)
1225        CALL histwrite_phy("vitu", u_seri)
1226        CALL histwrite_phy("vitv", v_seri)
1227        CALL histwrite_phy("geop", zphi)
1228        CALL histwrite_phy("pres", play)
1229        CALL histwrite_phy("dtvdf", d_t_vdf)
1230        CALL histwrite_phy("dqvdf", d_q_vdf)
1231        CALL histwrite_phy("rhum", zx_rh)
1232    
1233        if (ok_instan) call histsync(nid_ins)
1234    
1235        IF (lafin) then
1236           call NF95_CLOSE(ncid_startphy)
1237           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1238                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1239                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1240                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1241                w01)
1242        end IF
1243    
1244      end subroutine write_histins      firstcal = .FALSE.
1245    
1246    END SUBROUTINE physiq    END SUBROUTINE physiq
1247    

Legend:
Removed from v.103  
changed lines
  Added in v.205

  ViewVC Help
Powered by ViewVC 1.1.21