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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 49 by guez, Wed Aug 24 11:43:14 2011 UTC trunk/Sources/phylmd/physiq.f revision 154 by guez, Tue Jul 7 17:49:23 2015 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         qx, omega, d_u, d_v, d_t, d_qx)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! Author: Z.X. Li (LMD/CNRS) 1993      ! (subversion revision 678)
12    
13        ! 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 abort_gcm_m, only: abort_gcm      use aaam_bud_m, only: aaam_bud
18      USE calendar, only: ymds2ju      USE abort_gcm_m, ONLY: abort_gcm
19      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &      use aeropt_m, only: aeropt
20           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      use ajsec_m, only: ajsec
21      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use calltherm_m, only: calltherm
22           cycle_diurne, new_oliq, soil_model      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
23      use clmain_m, only: clmain           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      use comgeomphy      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
25      use concvl_m, only: concvl           ok_orodr, ok_orolf
26      use conf_gcm_m, only: raz_date, offline      USE clmain_m, ONLY: clmain
27      use conf_phys_m, only: conf_phys      use clouds_gno_m, only: clouds_gno
28      use ctherm      use comconst, only: dtphys
29      use dimens_m, only: jjm, iim, llm, nqmx      USE comgeomphy, ONLY: airephy
30      use dimphy, only: klon, nbtr      USE concvl_m, ONLY: concvl
31      use dimsoil, only: nsoilmx      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq
32      use fcttre, only: thermcep, foeew, qsats, qsatl      USE conf_phys_m, ONLY: conf_phys
33      use hgardfou_m, only: hgardfou      use conflx_m, only: conflx
34      USE histcom, only: histsync      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
35      USE histwrite_m, only: histwrite      use diagcld2_m, only: diagcld2
36      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      use diagetpq_m, only: diagetpq
37      use ini_histhf_m, only: ini_histhf      use diagphy_m, only: diagphy
38      use ini_histday_m, only: ini_histday      USE dimens_m, ONLY: llm, nqmx
39      use ini_histins_m, only: ini_histins      USE dimphy, ONLY: klon
40      use iniprint, only: prt_level      USE dimsoil, ONLY: nsoilmx
41      use oasis_m      use drag_noro_m, only: drag_noro
42      use orbite_m, only: orbite, zenang      use dynetat0_m, only: day_ref, annee_ref
43      use ozonecm_m, only: ozonecm      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
44      use phyetat0_m, only: phyetat0, rlat, rlon      use fisrtilp_m, only: fisrtilp
45      use phyredem_m, only: phyredem      USE hgardfou_m, ONLY: hgardfou
46      use phystokenc_m, only: phystokenc      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
47      use phytrac_m, only: phytrac           nbsrf
48      use qcheck_m, only: qcheck      USE ini_histins_m, ONLY: ini_histins
49      use radepsi      use newmicro_m, only: newmicro
50      use radopt      USE orbite_m, ONLY: orbite
51      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE ozonecm_m, ONLY: ozonecm
52      use temps, only: itau_phy, day_ref, annee_ref      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
53      use yoethf_m      USE phyredem_m, ONLY: phyredem
54        USE phystokenc_m, ONLY: phystokenc
55        USE phytrac_m, ONLY: phytrac
56        USE qcheck_m, ONLY: qcheck
57        use radlwsw_m, only: radlwsw
58        use readsulfate_m, only: readsulfate
59        use readsulfate_preind_m, only: readsulfate_preind
60        use sugwd_m, only: sugwd
61        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62        USE temps, ONLY: itau_phy
63        use unit_nml_m, only: unit_nml
64        USE ymds2ju_m, ONLY: ymds2ju
65        USE yoethf_m, ONLY: r2es, rvtmp2
66        use zenang_m, only: zenang
67    
68      ! Variables argument:      logical, intent(in):: lafin ! dernier passage
69    
70      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
71      ! (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
72    
73      REAL, intent(in):: time ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
     logical, intent(in):: lafin ! dernier passage  
74    
75      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! (pression pour chaque inter-couche, en Pa)      ! pression pour chaque inter-couche, en Pa
77    
78      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
79      ! (input pression pour le mileu de chaque couche (en Pa))      ! pression pour le mileu de chaque couche (en Pa)
80    
81      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! géopotentiel de chaque couche (référence sol)
83    
84      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
85    
86      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
87      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
       
     REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s  
     REAL t(klon, llm) ! input temperature (K)  
   
     REAL, intent(in):: qx(klon, llm, nqmx)  
     ! (humidité spécifique et fractions massiques des autres traceurs)  
   
     REAL omega(klon, llm) ! input vitesse verticale en Pa/s  
     REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)  
     REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)  
     REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)  
     REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon) ! output tendance physique de la pression au sol  
88    
89      LOGICAL:: firstcal = .true.      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s
90        REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
91    
92      INTEGER nbteta      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93      PARAMETER(nbteta=3)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      REAL PVteta(klon, nbteta)      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s
96      ! (output vorticite potentielle a des thetas constantes)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
97        REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
98        REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)
99    
100      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101      PARAMETER (ok_cvl=.TRUE.)      ! tendance physique de "qx" (s-1)
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust=.FALSE.)  
102    
103      LOGICAL check ! Verifier la conservation du modele en eau      ! Local:
     PARAMETER (check=.FALSE.)  
104    
105      LOGICAL, PARAMETER:: ok_stratus=.FALSE.      LOGICAL:: firstcal = .true.
     ! Ajouter artificiellement les stratus  
106    
107      ! Parametres lies au coupleur OASIS:      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
108      INTEGER, SAVE :: npas, nexca      PARAMETER (ok_gust = .FALSE.)
     logical rnpb  
     parameter(rnpb=.true.)  
109    
110      character(len=6), save:: ocean      LOGICAL, PARAMETER:: check = .FALSE.
111      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! Verifier la conservation du modele en eau
112    
113      logical ok_ocean      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
114      SAVE ok_ocean      ! Ajouter artificiellement les stratus
115    
116      ! "slab" ocean      ! "slab" ocean
117      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
# Line 122  contains Line 119  contains
119      REAL fluxo(klon) ! flux turbulents ocean-glace de mer      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
120      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
121    
122      ! Modele thermique du sol, a activer pour le cycle diurne:      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
123      logical, save:: ok_veget      ! sorties journalieres, mensuelles et instantanees dans les
124      LOGICAL, save:: ok_journe ! sortir le fichier journalier      ! fichiers histday, histmth et histins
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
   
     LOGICAL ok_instan ! sortir le fichier instantane  
     save ok_instan  
125    
126      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
127      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
128    
129      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
130      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
131      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
132      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
133    
134      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
135      PARAMETER (ivap=1)      INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
     INTEGER iliq ! indice de traceurs pour eau liquide  
     PARAMETER (iliq=2)  
136    
137      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
138      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
# Line 152  contains Line 142  contains
142    
143      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
144    
145      !IM Amip2 PV a theta constante      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
146        REAL swup0(klon, llm + 1), swup(klon, llm + 1)
     CHARACTER(LEN=3) ctetaSTD(nbteta)  
     DATA ctetaSTD/'350', '380', '405'/  
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
     INTEGER klevp1  
     PARAMETER(klevp1=llm+1)  
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
147      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
148    
149      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
150      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
151      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
152    
153      !IM Amip2      ! Amip2
154      ! variables a une pression donnee      ! variables a une pression donnee
155    
156      integer nlevSTD      integer nlevSTD
157      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
158      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
159      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
160           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
161           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
162      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
163      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
164           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
165           '70 ', '50 ', '30 ', '20 ', '10 '/           '70 ', '50 ', '30 ', '20 ', '10 '/
# Line 195  contains Line 173  contains
173      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
174    
175      INTEGER kmax, lmax      INTEGER kmax, lmax
176      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
177      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
178      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
179    
180      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
181      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
182      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
183    
184      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 208  contains Line 186  contains
186      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
187    
188      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
189      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
190    
191      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
192      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
193      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
194    
195      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
196      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
197           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
198           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 241  contains Line 219  contains
219           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
220           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
221    
222      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
223    
224      ! Variables propres a la physique      ! Variables propres a la physique
225    
226      INTEGER, save:: radpas      INTEGER, save:: radpas
227      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
228      ! "physiq".)      ! "physiq".
229    
230      REAL radsol(klon)      REAL radsol(klon)
231      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
# Line 262  contains Line 237  contains
237      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
238      ! soil temperature of surface fraction      ! soil temperature of surface fraction
239    
240      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
241      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
242      SAVE fluxlat      SAVE fluxlat
243    
244      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
245      SAVE fqsurf ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
246    
247      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: qsol(klon)
248        ! column-density of water in soil, in kg m-2
249    
250      REAL fsnow(klon, nbsrf)      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      SAVE fsnow ! epaisseur neigeuse      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface
252        REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface
253    
254      REAL falbe(klon, nbsrf)      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
     SAVE falbe ! albedo par type de surface  
     REAL falblw(klon, nbsrf)  
     SAVE falblw ! albedo par type de surface  
   
     ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :  
255      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
256      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
257      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 302  contains Line 273  contains
273      !KE43      !KE43
274      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
275    
     REAL bas, top ! cloud base and top levels  
     SAVE bas  
     SAVE top  
   
276      REAL Ma(klon, llm) ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
277      SAVE Ma      SAVE Ma
278      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
279      SAVE qcondc      SAVE qcondc
280      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
281      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
282    
283      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
284    
# Line 323  contains Line 287  contains
287      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
288      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
289    
290      !AA Pour phytrac      ! Pour phytrac :
291      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
292      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
293      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 342  contains Line 306  contains
306      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
307      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
308    
309      !AA      REAL, save:: rain_fall(klon)
310      REAL rain_fall(klon) ! pluie      ! liquid water mass flux (kg/m2/s), positive down
311      REAL snow_fall(klon) ! neige  
312      save snow_fall, rain_fall      REAL, save:: snow_fall(klon)
313      !IM cf FH pour Tiedtke 080604      ! solid water mass flux (kg/m2/s), positive down
314    
315      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
316    
317      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
318      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
319      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
320      SAVE dlw      SAVE dlw
321      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
322      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
323      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
324      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
325      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
326      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
327    
328      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
329      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
330    
331      ! Conditions aux limites      ! Conditions aux limites
332    
333      INTEGER julien      INTEGER julien
   
334      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
335      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
336      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
337      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total
338        REAL, save:: albsollw(klon) ! albedo du sol total
     SAVE pctsrf ! sous-fraction du sol  
     REAL albsol(klon)  
     SAVE albsol ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw ! albedo du sol total  
   
339      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
340    
341      ! Declaration des procedures appelees      ! Declaration des procedures appelees
342    
     EXTERNAL alboc ! calculer l'albedo sur ocean  
     EXTERNAL ajsec ! ajustement sec  
     !KE43  
     EXTERNAL conema3 ! convect4.3  
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
343      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
344      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
345    
346      ! Variables locales      ! Variables locales
347    
348      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
349      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
350    
351      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
352      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 418  contains Line 366  contains
366      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
367      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
368    
369      REAL heat(klon, llm) ! chauffage solaire      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
370      REAL heat0(klon, llm) ! chauffage solaire ciel clair      ! les variables soient r\'emanentes.
371      REAL cool(klon, llm) ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
372      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
373      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
374      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
375      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
376      REAL albpla(klon)      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
377        real, save:: sollwdown(klon) ! downward LW flux at surface
378        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
379        REAL, save:: albpla(klon)
380      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
381      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     ! Le rayonnement n'est pas calcule tous les pas, il faut donc  
     ! sauvegarder les sorties du rayonnement  
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
382    
383      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
384      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 444  contains Line 388  contains
388    
389      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
390    
391      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
392      REAL zdtime ! pas de temps du rayonnement (s)      real longi
     real zlongi  
   
393      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
394      REAL za, zb      REAL za, zb
395      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zcor
396      real zqsat(klon, llm)      real zqsat(klon, llm)
397      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
398      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup=234.0)  
   
399      REAL zphi(klon, llm)      REAL zphi(klon, llm)
400    
401      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
402    
403      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
404      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 478  contains Line 416  contains
416      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
417      REAL s_trmb3(klon)      REAL s_trmb3(klon)
418    
419      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
420    
421      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
422      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
423      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
     REAL tvp(klon, llm) ! virtual temp of lifted parcel  
424      REAL cape(klon) ! CAPE      REAL cape(klon) ! CAPE
425      SAVE cape      SAVE cape
426    
     REAL pbase(klon) ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon) ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon) ! flag fonctionnement de convect  
427      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     ! -- convect43:  
     INTEGER ntra ! nb traceurs pour convect4.3  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
428    
429      ! Variables du changement      ! Variables du changement
430    
431      ! con: convection      ! con: convection
432      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
433      ! ajs: ajustement sec      ! ajs: ajustement sec
434      ! eva: evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
435      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
436      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
437      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
438      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)
# Line 512  contains Line 440  contains
440      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
441      REAL rneb(klon, llm)      REAL rneb(klon, llm)
442    
443      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
444      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
445      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
446      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
447      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
448      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
449    
450      INTEGER ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
   
     SAVE ibas_con, itop_con  
451    
452      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
453      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 535  contains Line 461  contains
461      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
462      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
463    
464      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
465      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
466      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
467    
468      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
469      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
470      real, save:: facttemps      real:: facttemps = 1.e-4
471      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
472      real facteur      real facteur
473    
474      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
475      logical ptconv(klon, llm)      logical ptconv(klon, llm)
476    
477      ! Variables locales pour effectuer les appels en série      ! Variables locales pour effectuer les appels en s\'erie :
478    
479      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
480      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
481      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
482        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
483    
484      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
485    
# Line 567  contains Line 488  contains
488      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
489      REAL aam, torsfc      REAL aam, torsfc
490    
     REAL dudyn(iim+1, jjm + 1, llm)  
   
491      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
492    
493      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_ins
494    
495      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.
496      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.
497      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.
498      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.
499    
     REAL zsto  
   
     character(len=20) modname  
     character(len=80) abort_message  
     logical ok_sync  
500      real date0      real date0
501    
502      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
503      REAL ztsol(klon)      REAL ztsol(klon)
504      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_ec
505      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
     REAL fs_bound, fq_bound  
     SAVE d_h_vcol_phy  
506      REAL zero_v(klon)      REAL zero_v(klon)
507      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 20) tit
508      INTEGER ip_ebil ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
509      SAVE ip_ebil      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
510      DATA ip_ebil/0/  
511      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
     !+jld ec_conser  
     REAL d_t_ec(klon, llm) ! tendance du a la conersion Ec -> E thermique  
512      REAL ZRCPD      REAL ZRCPD
513      !-jld ec_conser  
     !IM: t2m, q2m, u10m, v10m  
514      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
515      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
516      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
517      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
518      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
519      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
520    
521        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
522    
523      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
524      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
525    
526      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
527      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
528    
529      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
530      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
531    
532      ! Aerosol optical properties      ! Aerosol optical properties
533      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
534      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
535    
536      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
537      ! ok_ade=True -ADE=topswad-topsw      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
   
     REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.  
     ! ok_aie=True ->  
     ! ok_ade=True -AIE=topswai-topswad  
     ! ok_ade=F -AIE=topswai-topsw  
538    
539      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
540    
541      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
542      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
543      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
544        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
545        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
546        ! B). They link cloud droplet number concentration to aerosol mass
547        ! concentration.
548    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
549      SAVE u10m      SAVE u10m
550      SAVE v10m      SAVE v10m
551      SAVE t2m      SAVE t2m
552      SAVE q2m      SAVE q2m
553      SAVE ffonte      SAVE ffonte
554      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
555      SAVE rain_con      SAVE rain_con
556      SAVE snow_con      SAVE snow_con
557      SAVE topswai      SAVE topswai
# Line 655  contains Line 560  contains
560      SAVE solswad      SAVE solswad
561      SAVE d_u_con      SAVE d_u_con
562      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
563    
564      real zmasse(klon, llm)      real zmasse(klon, llm)
565      ! (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)
566    
567      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
568    
569        namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
570             facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
571             ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals
572    
573      !----------------------------------------------------------------      !----------------------------------------------------------------
574    
575      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
576      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
577         DO i=1, klon           'eaux vapeur et liquide sont indispensables', 1)
           zero_v(i)=0.  
        END DO  
     END IF  
     ok_sync=.TRUE.  
     IF (nqmx < 2) THEN  
        abort_message = 'eaux vapeur et liquide sont indispensables'  
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
578    
579      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
580         ! initialiser         ! initialiser
581         u10m=0.         u10m = 0.
582         v10m=0.         v10m = 0.
583         t2m=0.         t2m = 0.
584         q2m=0.         q2m = 0.
585         ffonte=0.         ffonte = 0.
586         fqcalving=0.         fqcalving = 0.
587         piz_ae=0.         piz_ae = 0.
588         tau_ae=0.         tau_ae = 0.
589         cg_ae=0.         cg_ae = 0.
590         rain_con(:)=0.         rain_con = 0.
591         snow_con(:)=0.         snow_con = 0.
592         bl95_b0=0.         topswai = 0.
593         bl95_b1=0.         topswad = 0.
594         topswai(:)=0.         solswai = 0.
595         topswad(:)=0.         solswad = 0.
596         solswai(:)=0.  
597         solswad(:)=0.         d_u_con = 0.
598           d_v_con = 0.
599         d_u_con = 0.0         rnebcon0 = 0.
600         d_v_con = 0.0         clwcon0 = 0.
601         rnebcon0 = 0.0         rnebcon = 0.
602         clwcon0 = 0.0         clwcon = 0.
        rnebcon = 0.0  
        clwcon = 0.0  
603    
604         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
605         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 715  contains Line 612  contains
612         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
613         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
614    
615         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
616    
617         ! appel a la lecture du run.def physique         iflag_thermals = 0
618           nsplit_thermals = 1
619           print *, "Enter namelist 'physiq_nml'."
620           read(unit=*, nml=physiq_nml)
621           write(unit_nml, nml=physiq_nml)
622    
623         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys
             ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
624    
625         ! Initialiser les compteurs:         ! Initialiser les compteurs:
626    
627         frugs = 0.         frugs = 0.
628         itap = 0         itap = 0
629         itaprad = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
630         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &
631              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
632              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
633              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              run_off_lic_0, sig1, w01)
             ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)  
634    
635         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
636         q2=1.e-8         q2 = 1e-8
   
        radpas = NINT(86400. / dtphys / nbapp_rad)  
637    
638         ! on remet le calendrier a zero         lmt_pas = day_step / iphysiq
639         IF (raz_date) itau_phy = 0         print *, 'Number of time steps of "physics" per day: ', lmt_pas
640    
641         PRINT *, 'cycle_diurne = ', cycle_diurne         radpas = lmt_pas / nbapp_rad
642    
643         IF(ocean.NE.'force ') THEN         ! On remet le calendrier a zero
644            ok_ocean=.TRUE.         IF (raz_date) itau_phy = 0
        ENDIF  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
645    
646         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        print *,"Clef pour la convection, iflag_con=", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
647    
648         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
649         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
650              ibas_con = 1
651            print *,"*** Convection de Kerry Emanuel 4.3 "            itop_con = 1
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
652         ENDIF         ENDIF
653    
654         IF (ok_orodr) THEN         IF (ok_orodr) THEN
655            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
656            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
657         else         else
658            rugoro = 0.            rugoro = 0.
659         ENDIF         ENDIF
660    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
661         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
662         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
663         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
664         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
665         ecrit_reg = NINT(ecrit_reg/dtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
666    
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
        print *,'AVANT HIST IFLAG_CON=', iflag_con  
   
667         ! Initialisation des sorties         ! Initialisation des sorties
668    
        call ini_histhf(dtphys, nid_hf, nid_hf3d)  
        call ini_histday(dtphys, ok_journe, nid_day, nqmx)  
669         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
670         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
671         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
672         WRITE(*, *) 'physiq date0 : ', date0         print *, 'physiq date0: ', date0
673      ENDIF test_firstcal      ENDIF test_firstcal
674    
675      ! Mettre a zero des variables de sortie (pour securite)      ! We will modify variables *_seri and we will not touch variables
676        ! u, v, t, qx:
677        t_seri = t
678        u_seri = u
679        v_seri = v
680        q_seri = qx(:, :, ivap)
681        ql_seri = qx(:, :, iliq)
682        tr_seri = qx(:, :, 3: nqmx)
683    
684      DO i = 1, klon      ztsol = sum(ftsol * pctsrf, dim = 2)
        d_ps(i) = 0.0  
     ENDDO  
     DO iq = 1, nqmx  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
     da=0.  
     mp=0.  
     phi=0.  
   
     ! Ne pas affecter les valeurs entrees de u, v, h, et q  
   
     DO k = 1, llm  
        DO i = 1, klon  
           t_seri(i, k) = t(i, k)  
           u_seri(i, k) = u(i, k)  
           v_seri(i, k) = v(i, k)  
           q_seri(i, k) = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nqmx >= 3) THEN  
        tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
   
     DO i = 1, klon  
        ztsol(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
685    
686      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
687         ztit='after dynamic'         tit = 'after dynamics'
688         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
689              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
690              d_ql, d_qs, d_ec)         ! Comme les tendances de la physique sont ajout\'es dans la
691         ! Comme les tendances de la physique sont ajoute dans la dynamique,         !  dynamique, la variation d'enthalpie par la dynamique devrait
692         ! on devrait avoir que la variation d'entalpie par la dynamique         !  \^etre \'egale \`a la variation de la physique au pas de temps
693         ! est egale a la variation de la physique au pas de temps precedent.         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
694         ! Donc la somme de ces 2 variations devrait etre nulle.         !  nulle.
695         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
696              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
697              d_qt, 0., fs_bound, fq_bound)              d_qt, 0.)
698      END IF      END IF
699    
700      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
701      IF (ancien_ok) THEN      IF (ancien_ok) THEN
702         DO k = 1, llm         DO k = 1, llm
703            DO i = 1, klon            DO i = 1, klon
# Line 879  contains Line 708  contains
708      ELSE      ELSE
709         DO k = 1, llm         DO k = 1, llm
710            DO i = 1, klon            DO i = 1, klon
711               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
712               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
713            ENDDO            ENDDO
714         ENDDO         ENDDO
715         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 896  contains Line 725  contains
725      ! Check temperatures:      ! Check temperatures:
726      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
727    
728      ! Incrementer le compteur de la physique      ! Incrémenter le compteur de la physique
729      itap = itap + 1      itap = itap + 1
730      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
731      if (julien == 0) julien = 360      if (julien == 0) julien = 360
732    
733      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
734    
735      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Prescrire l'ozone :
736        wo = ozonecm(REAL(julien), paprs)
737    
738      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! \'Evaporation de l'eau liquide nuageuse :
739      if (nqmx >= 5) then      DO k = 1, llm
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Re-evaporer l'eau liquide nuageuse  
   
     DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse  
740         DO i = 1, klon         DO i = 1, klon
741            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
742            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
743            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
744            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
745         ENDDO         ENDDO
746      ENDDO      ENDDO
747        ql_seri = 0.
748    
749      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
750         ztit='after reevap'         tit = 'after reevap'
751         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
752              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
753              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
754         call diagphy(airephy, ztit, 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)
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
   
755      END IF      END IF
756    
757      ! Appeler la diffusion verticale (programme de couche limite)      frugs = MAX(frugs, 0.000015)
758        zxrugs = sum(frugs * pctsrf, dim = 2)
     DO i = 1, klon  
        zxrugs(i) = 0.0  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
759    
760      ! calculs necessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
761        ! la surface.
762    
763      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
764      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
765         zdtime = dtphys * REAL(radpas)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, time, zdtime, rmu0, fract)  
766      ELSE      ELSE
767         rmu0 = -999.999         mu0 = -999.999
768      ENDIF      ENDIF
769    
770      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
771      albsol(:)=0.      albsol = sum(falbe * pctsrf, dim = 2)
772      albsollw(:)=0.      albsollw = sum(falblw * pctsrf, dim = 2)
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)  
           albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
773    
774      ! Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
775      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
776    
777      DO nsrf = 1, nbsrf      forall (nsrf = 1: nbsrf)
778         DO i = 1, klon         fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &
779            fsollw(i, nsrf) = sollw(i) &              * (ztsol - ftsol(:, nsrf))
780                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))         fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
781            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))      END forall
        ENDDO  
     ENDDO  
782    
783      fder = dlw      fder = dlw
784    
785      ! Couche limite:      ! Couche limite:
786    
787      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
788           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
789           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
790           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, &
791           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, &
792           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
793           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
794           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
795           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           run_off_lic_0, fluxo, fluxg, tslab)
796           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)  
797        ! Incr\'ementation des flux
798      ! Incrémentation des flux  
799        zxfluxt = 0.
800      zxfluxt=0.      zxfluxq = 0.
801      zxfluxq=0.      zxfluxu = 0.
802      zxfluxu=0.      zxfluxv = 0.
     zxfluxv=0.  
803      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
804         DO k = 1, llm         DO k = 1, llm
805            DO i = 1, klon            DO i = 1, klon
806               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
807                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
808               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
809                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)
              zxfluxu(i, k) = zxfluxu(i, k) + &  
                   fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + &  
                   fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
810            END DO            END DO
811         END DO         END DO
812      END DO      END DO
813      DO i = 1, klon      DO i = 1, klon
814         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
815         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
816         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
817      ENDDO      ENDDO
818    
# Line 1037  contains Line 826  contains
826      ENDDO      ENDDO
827    
828      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
829         ztit='after clmain'         tit = 'after clmain'
830         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
831              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
832              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
833         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
834      END IF      END IF
835    
836      ! Update surface temperature:      ! Update surface temperature:
837    
838      DO i = 1, klon      DO i = 1, klon
839         zxtsol(i) = 0.0         zxtsol(i) = 0.
840         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
841    
842         zt2m(i) = 0.0         zt2m(i) = 0.
843         zq2m(i) = 0.0         zq2m(i) = 0.
844         zu10m(i) = 0.0         zu10m(i) = 0.
845         zv10m(i) = 0.0         zv10m(i) = 0.
846         zxffonte(i) = 0.0         zxffonte(i) = 0.
847         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
848    
849         s_pblh(i) = 0.0         s_pblh(i) = 0.
850         s_lcl(i) = 0.0         s_lcl(i) = 0.
851         s_capCL(i) = 0.0         s_capCL(i) = 0.
852         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
853         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
854         s_pblT(i) = 0.0         s_pblT(i) = 0.
855         s_therm(i) = 0.0         s_therm(i) = 0.
856         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
857         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
858         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
859    
860         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
861              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
862              THEN              'physiq : probl\`eme sous surface au point ', i, &
863            WRITE(*, *) 'physiq : pb sous surface au point ', i, &              pctsrf(i, 1 : nbsrf)
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
864      ENDDO      ENDDO
865      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
866         DO i = 1, klon         DO i = 1, klon
# Line 1103  contains Line 888  contains
888         ENDDO         ENDDO
889      ENDDO      ENDDO
890    
891      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :
   
892      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
893         DO i = 1, klon         DO i = 1, klon
894            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
# Line 1116  contains Line 900  contains
900            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
901            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
902                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
903            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
904            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
905            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
906            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
907            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
908            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
909            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
910            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
911            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
912            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
913         ENDDO         ENDDO
914      ENDDO      ENDDO
915    
916      ! Calculer la derive du flux infrarouge      ! Calculer la dérive du flux infrarouge
917    
918      DO i = 1, klon      DO i = 1, klon
919         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
920      ENDDO      ENDDO
921    
922        IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
923    
924      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
925    
926      DO k = 1, llm      if (iflag_con == 2) then
927         DO i = 1, klon         conv_q = d_q_dyn + d_q_vdf / dtphys
928            conv_q(i, k) = d_q_dyn(i, k) &         conv_t = d_t_dyn + d_t_vdf / dtphys
929                 + d_q_vdf(i, k)/dtphys         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
930            conv_t(i, k) = d_t_dyn(i, k) &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
931                 + d_t_vdf(i, k)/dtphys              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
932         ENDDO              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
933      ENDDO              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
934      IF (check) THEN              kdtop, pmflxr, pmflxs)
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *, "avantcon=", za  
     ENDIF  
     zx_ajustq = .FALSE.  
     IF (iflag_con == 2) zx_ajustq=.TRUE.  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
     IF (iflag_con == 1) THEN  
        stop 'reactiver le call conlmd dans physiq.F'  
     ELSE IF (iflag_con == 2) THEN  
        CALL conflx(dtphys, paprs, play, t_seri, q_seri, &  
             conv_t, conv_q, zxfluxq(1, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, &  
             pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
935         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
936         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
937         DO i = 1, klon         ibas_con = llm + 1 - kcbot
938            ibas_con(i) = llm+1 - kcbot(i)         itop_con = llm + 1 - kctop
939            itop_con(i) = llm+1 - kctop(i)      else
940         ENDDO         ! iflag_con >= 3
     ELSE IF (iflag_con >= 3) THEN  
        ! nb of tracers for the KE convection:  
        ! MAF la partie traceurs est faite dans phytrac  
        ! on met ntra=1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.  
        ntra = 1  
        ! Schema de convection modularise et vectorise:  
        ! (driver commun aux versions 3 et 4)  
   
        IF (ok_cvl) THEN ! new driver for convectL  
           CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &  
                d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &  
                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &  
                bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &  
                pmflxs, da, phi, mp)  
941    
942            clwcon0=qcondc         da = 0.
943            pmfu=upwd+dnwd         mp = 0.
944           phi = 0.
945           CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
946                w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
947                ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
948                qcondc, wd, pmflxr, pmflxs, da, phi, mp)
949           clwcon0 = qcondc
950           mfu = upwd + dnwd
951           IF (.NOT. ok_gust) wd = 0.
952    
953           IF (thermcep) THEN
954              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
955              zqsat = zqsat / (1. - retv * zqsat)
956         ELSE         ELSE
957            ! MAF conema3 ne contient pas les traceurs            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
           CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
   
        IF (.NOT. ok_gust) THEN  
           do i = 1, klon  
              wd(i)=0.0  
           enddo  
958         ENDIF         ENDIF
959    
960         ! Calcul des proprietes des nuages convectifs         ! Properties of convective clouds
961           clwcon0 = fact_cldcon * clwcon0
962         DO k = 1, llm         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
963            DO i = 1, klon              rnebcon0)
964               zx_t = t_seri(i, k)  
965               IF (thermcep) THEN         mfd = 0.
966                  zdelta = MAX(0., SIGN(1., rtt-zx_t))         pen_u = 0.
967                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)         pen_d = 0.
968                  zx_qs = MIN(0.5, zx_qs)         pde_d = 0.
969                  zcor = 1./(1.-retv*zx_qs)         pde_u = 0.
970                  zx_qs = zx_qs*zcor      END if
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/play(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/play(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k)=zx_qs  
           ENDDO  
        ENDDO  
   
        ! calcul des proprietes des nuages convectifs  
        clwcon0=fact_cldcon*clwcon0  
        call clouds_gno &  
             (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)  
     ELSE  
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     ENDIF  
971    
972      DO k = 1, llm      DO k = 1, llm
973         DO i = 1, klon         DO i = 1, klon
# Line 1256  contains Line 979  contains
979      ENDDO      ENDDO
980    
981      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
982         ztit='after convect'         tit = 'after convect'
983         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
984              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
985              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
986         call diagphy(airephy, ztit, 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)
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
987      END IF      END IF
988    
989      IF (check) THEN      IF (check) THEN
990         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
991         print *,"aprescon=", za         print *, "aprescon = ", za
992         zx_t = 0.0         zx_t = 0.
993         za = 0.0         za = 0.
994         DO i = 1, klon         DO i = 1, klon
995            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
996            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
997                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
998         ENDDO         ENDDO
999         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1000         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1001      ENDIF      ENDIF
1002      IF (zx_ajustq) THEN  
1003         DO i = 1, klon      IF (iflag_con == 2) THEN
1004            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1005         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtphys) &  
                /z_apres(i)  
        ENDDO  
1006         DO k = 1, llm         DO k = 1, llm
1007            DO i = 1, klon            DO i = 1, klon
1008               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1009                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1010               ENDIF               ENDIF
1011            ENDDO            ENDDO
1012         ENDDO         ENDDO
1013      ENDIF      ENDIF
     zx_ajustq=.FALSE.  
1014    
1015      ! Convection seche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1016    
1017      d_t_ajs=0.      d_t_ajs = 0.
1018      d_u_ajs=0.      d_u_ajs = 0.
1019      d_v_ajs=0.      d_v_ajs = 0.
1020      d_q_ajs=0.      d_q_ajs = 0.
1021      fm_therm=0.      fm_therm = 0.
1022      entr_therm=0.      entr_therm = 0.
1023    
1024      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1025         ! Ajustement sec         ! Ajustement sec
# Line 1324  contains Line 1033  contains
1033      endif      endif
1034    
1035      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1036         ztit='after dry_adjust'         tit = 'after dry_adjust'
1037         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1038              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1039      END IF      END IF
1040    
1041      ! Caclul des ratqs      ! Caclul des ratqs
1042    
1043      ! 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
1044      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1045      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1046         do k=1, llm         do k = 1, llm
1047            do i=1, klon            do i = 1, klon
1048               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1049                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1050                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1051               else               else
1052                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1053               endif               endif
1054            enddo            enddo
1055         enddo         enddo
1056      endif      endif
1057    
1058      ! ratqs stables      ! ratqs stables
1059      do k=1, llm      do k = 1, llm
1060         do i=1, klon         do i = 1, klon
1061            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1062                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1063         enddo         enddo
1064      enddo      enddo
1065    
1066      ! ratqs final      ! ratqs final
1067      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1068         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1069         ! ratqs final         ! ratqs final
1070         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1071         ! relaxation des ratqs         ! relaxation des ratqs
1072         facteur=exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
1073         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs, ratqsc)
        ratqs=max(ratqs, ratqsc)  
1074      else      else
1075         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1076         ratqs=ratqss         ratqs = ratqss
1077      endif      endif
1078    
1079      ! Appeler le processus de condensation a grande echelle      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1080      ! et le processus de precipitation           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1081      CALL fisrtilp(dtphys, paprs, play, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1082           t_seri, q_seri, ptconv, ratqs, &           psfl, rhcl)
          d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &  
          rain_lsc, snow_lsc, &  
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1083    
1084      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1085      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1391  contains Line 1093  contains
1093         ENDDO         ENDDO
1094      ENDDO      ENDDO
1095      IF (check) THEN      IF (check) THEN
1096         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(paprs, q_seri, ql_seri)
1097         print *,"apresilp=", za         print *, "apresilp = ", za
1098         zx_t = 0.0         zx_t = 0.
1099         za = 0.0         za = 0.
1100         DO i = 1, klon         DO i = 1, klon
1101            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1102            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1103                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1104         ENDDO         ENDDO
1105         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1106         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1107      ENDIF      ENDIF
1108    
1109      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1110         ztit='after fisrt'         tit = 'after fisrt'
1111         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1112              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1113              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1114         call diagphy(airephy, ztit, 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)
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
1115      END IF      END IF
1116    
1117      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1118    
1119      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1120    
1121      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1122         snow_tiedtke=0.         ! seulement pour Tiedtke
1123           snow_tiedtke = 0.
1124         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1125            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1126         else         else
1127            rain_tiedtke=0.            rain_tiedtke = 0.
1128            do k=1, llm            do k = 1, llm
1129               do i=1, klon               do i = 1, klon
1130                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1131                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1132                          *zmasse(i, k)                          *zmasse(i, k)
1133                  endif                  endif
1134               enddo               enddo
# Line 1435  contains Line 1136  contains
1136         endif         endif
1137    
1138         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1139         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1140              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1141         DO k = 1, llm         DO k = 1, llm
1142            DO i = 1, klon            DO i = 1, klon
1143               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1144                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1145                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1146               ENDIF               ENDIF
1147            ENDDO            ENDDO
1148         ENDDO         ENDDO
1149      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1150         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1151         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
1152         ! facttemps         ! d'un facteur facttemps.
1153         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1154         do k=1, llm         do k = 1, llm
1155            do i=1, klon            do i = 1, klon
1156               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1157               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1158                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1159                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1160                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1161               endif               endif
1162            enddo            enddo
1163         enddo         enddo
1164    
1165         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1166         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1167         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
1168      ENDIF      ENDIF
1169    
1170      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1171    
1172      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1173         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1174         DO k = 1, llm         DO k = 1, llm
1175            DO i = 1, klon            DO i = 1, klon
1176               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1177                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1178                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1179               ENDIF               ENDIF
# Line 1482  contains Line 1182  contains
1182      ENDIF      ENDIF
1183    
1184      ! Precipitation totale      ! Precipitation totale
   
1185      DO i = 1, klon      DO i = 1, klon
1186         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1187         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1188      ENDDO      ENDDO
1189    
1190      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1191         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1192         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_qt, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
1193    
1194        ! Humidit\'e relative pour diagnostic :
1195      DO k = 1, llm      DO k = 1, llm
1196         DO i = 1, klon         DO i = 1, klon
1197            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1198            IF (thermcep) THEN            IF (thermcep) THEN
1199               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
              zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)  
1200               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1201               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1202               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
# Line 1514  contains Line 1208  contains
1208               ENDIF               ENDIF
1209            ENDIF            ENDIF
1210            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1211            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1212         ENDDO         ENDDO
1213      ENDDO      ENDDO
1214      !jq - introduce the aerosol direct and first indirect radiative forcings  
1215      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1216      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1217         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1218         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1219         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1220    
1221         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1222         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1223      ELSE      ELSE
1224         tau_ae=0.0         tau_ae = 0.
1225         piz_ae=0.0         piz_ae = 0.
1226         cg_ae=0.0         cg_ae = 0.
1227      ENDIF      ENDIF
1228    
1229      ! Calculer les parametres optiques des nuages et quelques      ! Param\`etres optiques des nuages et quelques param\`etres pour
1230      ! parametres pour diagnostiques:      ! diagnostics :
   
1231      if (ok_newmicro) then      if (ok_newmicro) then
1232         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1233              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1234              cldh, cldl, cldm, cldt, cldq, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             flwp, fiwp, flwc, fiwc, &  
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1235      else      else
1236         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1237              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1238              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1239      endif      endif
1240    
1241      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
1242           ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
     IF (MOD(itaprad, radpas) == 0) THEN  
1243         DO i = 1, klon         DO i = 1, klon
1244            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
1245                 + falbe(i, is_lic) * pctsrf(i, is_lic) &                 + falbe(i, is_lic) * pctsrf(i, is_lic) &
# Line 1569  contains Line 1250  contains
1250                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1251                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1252         ENDDO         ENDDO
1253         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1254         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &
1255              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1256              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1257              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1258              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1259              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1260      ENDIF      ENDIF
     itaprad = itaprad + 1  
1261    
1262      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1263    
1264      DO k = 1, llm      DO k = 1, llm
1265         DO i = 1, klon         DO i = 1, klon
1266            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * dtphys/86400.  
1267         ENDDO         ENDDO
1268      ENDDO      ENDDO
1269    
1270      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1271         ztit='after rad'         tit = 'after rad'
1272         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1273              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
1274              d_ql, d_qs, d_ec)         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1275         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &  
             fs_bound, fq_bound)  
1276      END IF      END IF
1277    
1278      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1279      DO i = 1, klon      DO i = 1, klon
1280         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1281         zxsnow(i) = 0.0         zxsnow(i) = 0.
1282      ENDDO      ENDDO
1283      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1284         DO i = 1, klon         DO i = 1, klon
# Line 1611  contains Line 1287  contains
1287         ENDDO         ENDDO
1288      ENDDO      ENDDO
1289    
1290      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1291    
1292      DO i = 1, klon      DO i = 1, klon
1293         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1294      ENDDO      ENDDO
1295    
1296      !mod deb lott(jan95)      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1297    
1298      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1299         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1300         igwd=0         igwd = 0
1301         DO i=1, klon         DO i = 1, klon
1302            itest(i)=0            itest(i) = 0
1303            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1304               itest(i)=1               itest(i) = 1
1305               igwd=igwd+1               igwd = igwd + 1
1306               idx(igwd)=i               idx(igwd) = i
1307            ENDIF            ENDIF
1308         ENDDO         ENDDO
1309    
1310         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1311              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1312              igwd, idx, itest, &              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1313    
1314         ! ajout des tendances         ! ajout des tendances
1315         DO k = 1, llm         DO k = 1, llm
# Line 1651  contains Line 1322  contains
1322      ENDIF      ENDIF
1323    
1324      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1325         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1326         igwd=0         igwd = 0
1327         DO i=1, klon         DO i = 1, klon
1328            itest(i)=0            itest(i) = 0
1329            IF ((zpic(i)-zmea(i)).GT.100.) THEN            IF ((zpic(i) - zmea(i)) > 100.) THEN
1330               itest(i)=1               itest(i) = 1
1331               igwd=igwd+1               igwd = igwd + 1
1332               idx(igwd)=i               idx(igwd) = i
1333            ENDIF            ENDIF
1334         ENDDO         ENDDO
1335    
# Line 1666  contains Line 1337  contains
1337              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1338              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1339    
1340         ! ajout des tendances         ! Ajout des tendances :
1341         DO k = 1, llm         DO k = 1, llm
1342            DO i = 1, klon            DO i = 1, klon
1343               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1676  contains Line 1347  contains
1347         ENDDO         ENDDO
1348      ENDIF      ENDIF
1349    
1350      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress n\'ecessaires : toute la physique
1351    
1352      DO i = 1, klon      DO i = 1, klon
1353         zustrph(i)=0.         zustrph(i) = 0.
1354         zvstrph(i)=0.         zvstrph(i) = 0.
1355      ENDDO      ENDDO
1356      DO k = 1, llm      DO k = 1, llm
1357         DO i = 1, klon         DO i = 1, klon
1358            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1359            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1360              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1361                   * zmasse(i, k)
1362         ENDDO         ENDDO
1363      ENDDO      ENDDO
1364    
1365      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1366             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1367    
1368      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1369           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1370           aam, torsfc)           d_qt, d_ec)
   
     IF (if_ebil >= 2) THEN  
        ztit='after orography'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1371    
1372      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1373      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1374           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1375           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1376           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           upwd, dnwd, tr_seri, zmasse)
1377           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &  
1378           tr_seri, zmasse)      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1379             pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1380      IF (offline) THEN           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
        call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &  
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1381    
1382      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1383      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1722  contains Line 1385  contains
1385    
1386      ! diag. bilKP      ! diag. bilKP
1387    
1388      CALL transp_lay (paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
1389           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1390    
1391      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1392    
1393      !+jld ec_conser      ! conversion Ec -> E thermique
1394      DO k = 1, llm      DO k = 1, llm
1395         DO i = 1, klon         DO i = 1, klon
1396            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1397            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1398                 *(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)
1399            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)
1400            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1401         END DO         END DO
1402      END DO      END DO
1403      !-jld ec_conser  
1404      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1405         ztit='after physic'         tit = 'after physic'
1406         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1407              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)
             d_ql, d_qs, d_ec)  
1408         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1409         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1410         ! est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1411         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1412         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1413              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec)
1414              fs_bound, fq_bound)         d_h_vcol_phy = d_h_vcol
   
        d_h_vcol_phy=d_h_vcol  
   
1415      END IF      END IF
1416    
1417      ! SORTIES      ! SORTIES
1418    
1419      !cc prw = eau precipitable      ! prw = eau precipitable
1420      DO i = 1, klon      DO i = 1, klon
1421         prw(i) = 0.         prw(i) = 0.
1422         DO k = 1, llm         DO k = 1, llm
# Line 1777  contains Line 1436  contains
1436         ENDDO         ENDDO
1437      ENDDO      ENDDO
1438    
1439      IF (nqmx >= 3) THEN      DO iq = 3, nqmx
1440         DO iq = 3, nqmx         DO k = 1, llm
1441            DO k = 1, llm            DO i = 1, klon
1442               DO i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys  
              ENDDO  
1443            ENDDO            ENDDO
1444         ENDDO         ENDDO
1445      ENDIF      ENDDO
1446    
1447      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1448      DO k = 1, llm      DO k = 1, llm
# Line 1796  contains Line 1453  contains
1453      ENDDO      ENDDO
1454    
1455      ! Ecriture des sorties      ! Ecriture des sorties
     call write_histhf  
     call write_histday  
1456      call write_histins      call write_histins
1457    
1458      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1459      IF (lafin) THEN      IF (lafin) THEN
1460         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1461         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1462              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1463              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1464              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1465              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              run_off_lic_0, sig1, w01)
1466      ENDIF      ENDIF
1467    
1468      firstcal = .FALSE.      firstcal = .FALSE.
1469    
1470    contains    contains
1471    
     subroutine write_histday  
   
       use gr_phy_write_3d_m, only: gr_phy_write_3d  
       integer itau_w ! pas de temps ecriture  
   
       !------------------------------------------------  
   
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nqmx <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
   
1472      subroutine write_histins      subroutine write_histins
1473    
1474        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1475    
1476        real zout        use dimens_m, only: iim, jjm
1477        integer itau_w ! pas de temps ecriture        USE histsync_m, ONLY: histsync
1478          USE histwrite_m, ONLY: histwrite
1479    
1480          integer i, itau_w ! pas de temps ecriture
1481          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1482    
1483        !--------------------------------------------------        !--------------------------------------------------
1484    
1485        IF (ok_instan) THEN        IF (ok_instan) THEN
1486           ! Champs 2D:           ! Champs 2D:
1487    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1488           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1489    
1490           i = NINT(zout/zsto)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)  
1491           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1492    
1493           i = NINT(zout/zsto)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)  
1494           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1495    
1496           DO i = 1, klon           DO i = 1, klon
1497              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1498           ENDDO           ENDDO
1499           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1500           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1501    
1502           DO i = 1, klon           DO i = 1, klon
1503              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1504           ENDDO           ENDDO
1505           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1506           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1507    
1508           DO i = 1, klon           DO i = 1, klon
1509              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1510           ENDDO           ENDDO
1511           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1512           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1513    
1514           DO i = 1, klon           DO i = 1, klon
1515              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1516           ENDDO           ENDDO
1517           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1518           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1519    
1520           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1521           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1522           !ccIM           !ccIM
1523           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1524           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1525    
1526           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1527           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1528    
1529           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1530           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1531    
1532           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1533           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1534    
1535           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1536           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1537    
1538           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1539           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1540    
1541           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1542           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1543    
1544           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1545           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1546    
1547           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1548           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1549    
1550           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1551           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1552    
1553           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1554           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1555    
1556           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1557           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1558    
1559           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1560           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1561    
1562           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1563           ! CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1564           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1565           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1566    
1567           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1568           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1569    
1570           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1571           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1572    
1573           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1574           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1575    
1576           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1577           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1578    
1579           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1580           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1581    
1582           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1583              !XXX              !XXX
1584              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1585              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1586              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1587                   zx_tmp_2d)                   zx_tmp_2d)
1588    
1589              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1590              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1591              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1592                   zx_tmp_2d)                   zx_tmp_2d)
1593    
1594              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1595              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1596              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1597                   zx_tmp_2d)                   zx_tmp_2d)
1598    
1599              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1600              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1601              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1602                   zx_tmp_2d)                   zx_tmp_2d)
1603    
1604              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1605              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1606              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1607                   zx_tmp_2d)                   zx_tmp_2d)
1608    
1609              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1610              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1611              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1612                   zx_tmp_2d)                   zx_tmp_2d)
1613    
1614              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1615              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1616              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1617                   zx_tmp_2d)                   zx_tmp_2d)
1618    
1619              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1620              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1621              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1622                   zx_tmp_2d)                   zx_tmp_2d)
1623    
1624              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1625              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1626              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1627                   zx_tmp_2d)                   zx_tmp_2d)
1628    
1629           END DO           END DO
1630           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1631           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1632           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1633           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1634    
1635           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1636           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1637    
          !IM cf. AM 081204 BEG  
   
1638           !HBTM2           !HBTM2
1639    
1640           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1641           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1642    
1643           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1644           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1645    
1646           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1647           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1648    
1649           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
1650           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1651    
1652           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
1653           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1654    
1655           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
1656           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1657    
1658           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
1659           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1660    
1661           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
1662           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1663    
1664           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
1665           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1666    
1667           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
1668           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1669    
          !IM cf. AM 081204 END  
   
1670           ! Champs 3D:           ! Champs 3D:
1671    
1672           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
1673           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1674    
1675           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
1676           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1677    
1678           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
1679           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1680    
1681           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
1682           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1683    
1684           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), play, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
1685           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1686    
1687           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
1688           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1689    
1690           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1691           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1692    
1693           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1694        ENDIF        ENDIF
1695    
1696      end subroutine write_histins      end subroutine write_histins
1697    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09  
   
       integer itau_w ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1698    END SUBROUTINE physiq    END SUBROUTINE physiq
1699    
1700  end module physiq_m  end module physiq_m

Legend:
Removed from v.49  
changed lines
  Added in v.154

  ViewVC Help
Powered by ViewVC 1.1.21