Context Navigation

phytracr_spl_mod.F90 @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 2 months ago
Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad Create lmdz_yoerad.f90 (lint) Remove "!" on otherwise empty line
File size: 173.2 KB

Line
1	! $Id: physiq.F90 2298 2015-06-14 19:13:32Z fairhead $
2	!#define IO_DEBUG
3
4	MODULE phytracr_spl_mod
5
6	! Recuperation des morceaux de la physique de Jeronimo specifiques
7	! du modele d'aerosols d'Olivier n'co.
8
9	INCLUDE "chem.h"
10	INCLUDE "chem_spla.h"
11
12	REAL, SAVE :: scale_param_ssacc !Scaling parameter for Fine Sea Salt
13	REAL, SAVE :: scale_param_sscoa !Scaling parameter for Coarse Sea Salt
14
15	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ind !Scaling parameter for industrial emissions of SO2
16	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_bb !Scaling parameter for biomas burning (SO2,BC & OM)
17	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ff !Scaling parameter for industrial emissions (fossil fuel)
18	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustacc !Scaling parameter for Fine Dust
19	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustcoa !Scaling parameter for Coarse Dust
20	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustsco !Scaling parameter for SCoarse Dust
21	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarBLperregion !parameter for ..
22	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarWAKEperregion !parameter for ..
23	!$OMP THREADPRIVATE(scale_param_ind,scale_param_bb,scale_param_ff)
24	!$OMP THREADPRIVATE(scale_param_dustacc,scale_param_dustcoa,scale_param_dustsco)
25	!$OMP THREADPRIVATE(scale_param_ssacc,scale_param_sscoa)
26	!$OMP THREADPRIVATE(param_wstarBLperregion,param_wstarWAKEperregion)
27	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dust_ec, u10m_ec, v10m_ec
28	!$OMP THREADPRIVATE(dust_ec, u10m_ec, v10m_ec)
29
30	CHARACTER*800 fileregionsdimsind
31	CHARACTER*800 fileregionsdimsdust
32	CHARACTER*800 fileregionsdimsbb
33	CHARACTER*800 fileregionsdimswstar
34	CHARACTER*100 paramname_ind
35	CHARACTER*100 paramname_bb
36	CHARACTER*100 paramname_ff
37	CHARACTER*100 paramname_dustacc
38	CHARACTER*100 paramname_dustcoa
39	CHARACTER*100 paramname_dustsco
40	CHARACTER*100 paramname_ssacc
41	CHARACTER*100 paramname_sscoa
42	CHARACTER*100 paramname_wstarBL
43	CHARACTER*100 paramname_wstarWAKE
44
45	CHARACTER*800 filescaleparams
46	CHARACTER*800 paramsname
47
48
49	!!------------------------ SULFUR emissions ----------------------------
50	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_cont ! emissions so2 volcan continuous
51	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_cont ! altitude so2 volcan continuous
52	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_expl ! emissions so2 volcan explosive
53	!$OMP THREADPRIVATE( lmt_so2volc_cont,lmt_altvolc_cont,lmt_so2volc_expl )
54	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_expl ! altitude so2 volcan explosive
55	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_l ! emissions so2 fossil fuel (low)
56	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_h ! emissions so2 fossil fuel (high)
57	!$OMP THREADPRIVATE( lmt_altvolc_expl,lmt_so2ff_l,lmt_so2ff_h )
58	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2nff ! emissions so2 non-fossil fuel
59	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ba ! emissions de so2 bateau
60	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_l ! emissions de so2 biomass burning (low)
61	!$OMP THREADPRIVATE( lmt_so2nff,lmt_so2ba,lmt_so2bb_l )
62	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_h ! emissions de so2 biomass burning (high)
63	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsconc ! concentration de dms oceanique
64	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsbio ! emissions de dms bio
65	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_h2sbio ! emissions de h2s bio
66	!$OMP THREADPRIVATE(lmt_so2bb_h,lmt_dmsconc,lmt_dmsbio,lmt_h2sbio )
67	!------------------------- BLACK CARBON emissions ----------------------
68	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcff ! emissions de BC fossil fuels
69	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcnff ! emissions de BC non-fossil fuels
70	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_l ! emissions de BC biomass basses
71	!$OMP THREADPRIVATE( lmt_bcff,lmt_bcnff,lmt_bcbb_l)
72	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_h ! emissions de BC biomass hautes
73	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcba ! emissions de BC bateau
74	!$OMP THREADPRIVATE(lmt_bcbb_h,lmt_bcba)
75	!------------------------ ORGANIC MATTER emissions ---------------------
76	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omff ! emissions de OM fossil fuels
77	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnff ! emissions de OM non-fossil fuels
78	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_l ! emissions de OM biomass basses
79	!$OMP THREADPRIVATE( lmt_omff,lmt_omnff,lmt_ombb_l)
80	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_h ! emissions de OM biomass hautes
81	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnat ! emissions de OM Natural
82	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omba ! emissions de OM bateau
83	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: lmt_sea_salt ! emissions de OM Natural
84	!$OMP THREADPRIVATE(lmt_ombb_h,lmt_omnat,lmt_omba,lmt_sea_salt)
85
86	!JE20141224 >>
87	! others
88	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tsol
89	!$OMP THREADPRIVATE(tsol)
90	INTEGER :: ijulday
91	LOGICAL, parameter :: edgar = .true.
92	INTEGER, parameter :: flag_dms = 4
93	INTEGER(kind = 4) nbjour
94
95	! Tracer tendencies, for outputs
96	!-------------------------------
97	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl ! Td couche
98	!. limite/traceur
99	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dec
100	!RomP
101	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv ! Td
102	!onvection/traceur
103	! RomP >>>
104	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc
105	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav
106	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls
107	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls
108	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp
109	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav
110	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat
111	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav
112	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPr, qDi ! concentration tra
113	!dans pluie,air descente insaturee
114	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPa, qMel
115	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qTrdi, dtrcvMA ! conc traceur
116	!descente air insaturee et td convective MA
117	!! RomP <<<
118	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th ! Td thermique
119	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_impa ! Td du
120	!lessivage par impaction
121	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_nucl ! Td du
122	!lessivage par nucleation
123	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: qPrls !jyg:
124	!oncentration tra dans pluie LS a la surf.
125	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dry ! Td depot
126	!sec/traceur (1st layer),ALLOCATABLE,SAVE jyg
127	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: flux_tr_dry ! depot
128	!sec/traceur (surface),ALLOCATABLE,SAVE jyg
129
130	! Index of each traceur
131	INTEGER, SAVE :: id_prec, id_fine, id_coss, id_codu, id_scdu
132
133	!$OMP THREADPRIVATE(d_tr_cl,d_tr_dec,d_tr_cv,d_tr_insc,d_tr_bcscav,d_tr_evapls)
134	!$OMP THREADPRIVATE(d_tr_ls,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav)
135	!$OMP THREADPRIVATE(qPr,qDi,qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa)
136	!$OMP THREADPRIVATE(d_tr_lessi_nucl,qPrls,d_tr_dry,flux_tr_dry)
137	!$OMP THREADPRIVATE(id_prec,id_fine,id_coss,id_codu,id_scdu)
138
139	! JE20141224 <<
140
141	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tot ! epaisseur optique total aerosol 550 nm
142	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tot ! epaisseur optique total aerosol 670 nm
143	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tot ! epaisseur optique total aerosol 865 nm
144	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tr2 ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic
145	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tr2 ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic
146	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tr2 ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic
147	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_ss ! epaisseur optique Sels marins aerosol 550 nm, diagnostic
148	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_ss ! epaisseur optique Sels marins aerosol 670 nm, diagnostic
149	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_ss ! epaisseur optique Sels marins aerosol 865 nm, diagnostic
150	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dust ! epaisseur optique Dust aerosol 550 nm, diagnostic
151	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dust ! epaisseur optique Dust aerosol 670 nm, diagnostic
152	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dust ! epaisseur optique Dust aerosol 865 nm, diagnostic
153	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dustsco ! epaisseur optique Dust SCOarse aerosol 550 nm, diagnostic
154	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dustsco ! epaisseur optique Dust SCOarse aerosol 670 nm, diagnostic
155	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dustsco ! epaisseur optique Dust SCOarse aerosol 865 nm, diagnostic
156
157	!$OMP THREADPRIVATE(diff_aod550_tot,diag_aod670_tot,diag_aod865_tot)
158	!$OMP THREADPRIVATE(diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2)
159	!$OMP THREADPRIVATE(diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,diag_aod550_dust)
160	!$OMP THREADPRIVATE(diag_aod670_dust,diag_aod865_dust,diag_aod550_dustsco)
161	!$OMP THREADPRIVATE(diag_aod670_dustsco,diag_aod865_dustsco)
162
163	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_terra ! AOD at terra overpass time ( 10.30 local hour)
164	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
165	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
166	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
167	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
168	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_terra ! AOD at terra overpass time ( 10.30 local hour)
169	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
170	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
171	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
172	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
173	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_terra ! AOD at terra overpass time ( 10.30 local hour)
174	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
175	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
176	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
177	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
178
179	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_aqua ! AOD at aqua overpass time ( 13.30 local hour)
180	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
181	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
182	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
183	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
184	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_aqua ! AOD at aqua overpass time ( 13.30 local hour)
185	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
186	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
187	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
188	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
189	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_aqua ! AOD at aqua overpass time ( 13.30 local hour)
190	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
191	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
192	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
193	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
194
195	!$OMP THREADPRIVATE(aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua)
196	!$OMP THREADPRIVATE(aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua)
197	!$OMP THREADPRIVATE(aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua)
198	!$OMP THREADPRIVATE(aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra)
199	!$OMP THREADPRIVATE(aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra)
200	!$OMP THREADPRIVATE(aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra)
201
202	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc01 ! surface concentration
203	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm01 ! burden
204	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc02 ! surface concentration
205	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm02 ! burden
206	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc03 ! surface concentration
207	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm03 ! burden
208	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc04 ! surface concentration
209	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm04 ! burden
210	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc05 ! surface concentration
211	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm05 ! burden
212	!$OMP THREADPRIVATE(sconc01,sconc02,sconc03,sconc04,sconc05)
213	!$OMP THREADPRIVATE(trm01,trm02,trm03,trm04,trm05)
214	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux01
215	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux02
216	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux03
217	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux04
218	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux05
219	!$OMP THREADPRIVATE(flux01,flux02,flux03,flux04,flux05)
220	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds01
221	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds02
222	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds03
223	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds04
224	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds05
225	!$OMP THREADPRIVATE(ds01,ds02,ds03,ds04,ds05)
226	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh01
227	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh02
228	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh03
229	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh04
230	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh05
231	!$OMP THREADPRIVATE(dh01,dh02,dh03,dh04,dh05)
232	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv01
233	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv02
234	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv03
235	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv04
236	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv05
237	!$OMP THREADPRIVATE(dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05)
238	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm01
239	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm02
240	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm03
241	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm04
242	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm05
243	!$OMP THREADPRIVATE(dtherm01,dtherm02,dtherm03,dtherm04,dtherm05)
244	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv01
245	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv02
246	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv03
247	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv04
248	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv05
249	!$OMP THREADPRIVATE(dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05)
250	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds01
251	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds02
252	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds03
253	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds04
254	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds05
255	!$OMP THREADPRIVATE(d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05)
256	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc01
257	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc02
258	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc03
259	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc04
260	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc05
261	!$OMP THREADPRIVATE(dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05)
262	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv01
263	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv02
264	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv03
265	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv04
266	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv05
267	!$OMP THREADPRIVATE(d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05)
268	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp01
269	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp02
270	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp03
271	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp04
272	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp05
273	!$OMP THREADPRIVATE(d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05)
274	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav01
275	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav02
276	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav03
277	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav04
278	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav05
279	!$OMP THREADPRIVATE(d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05)
280	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat01
281	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat02
282	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat03
283	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat04
284	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat05
285	!$OMP THREADPRIVATE(d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05)
286	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav01
287	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav02
288	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav03
289	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav04
290	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav05
291	!$OMP THREADPRIVATE(d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05)
292
293	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
294	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
295	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
296
297	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc01
298	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc02
299	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc03
300	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc04
301	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc05
302	!$OMP THREADPRIVATE(d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05)
303	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav01
304	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav02
305	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav03
306	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav04
307	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav05
308	!$OMP THREADPRIVATE(d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05)
309	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls01
310	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls02
311	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls03
312	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls04
313	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls05
314	!$OMP THREADPRIVATE(d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05)
315	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls01
316	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls02
317	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls03
318	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls04
319	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls05
320	!$OMP THREADPRIVATE(d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05)
321
322	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn01
323	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn02
324	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn03
325	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn04
326	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn05
327	!$OMP THREADPRIVATE(d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05)
328
329	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl01
330	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl02
331	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl03
332	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl04
333	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl05
334	!$OMP THREADPRIVATE(d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05)
335
336	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th01
337	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th02
338	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th03
339	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th04
340	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th05
341	!$OMP THREADPRIVATE(d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05)
342
343	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_ss3D ! corresponds to tracer 3
344	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dust3D ! corresponds to tracer 4
345	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dustsco3D ! corresponds to tracer 4
346	!$OMP THREADPRIVATE(sed_ss3D,sed_dust3D,sed_dustsco3D)
347
348	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
349	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
350	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_ss ! corresponds to tracer 3
351	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dust ! corresponds to tracer 4
352	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dustsco ! corresponds to tracer 4
353	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2pgas ! corresponds to tracer 4
354	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2paer ! corresponds to tracer 4
355	!$OMP THREADPRIVATE(sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer)
356
357	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbb
358	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxff
359	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcbb
360	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcff
361	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcnff
362	!$OMP THREADPRIVATE(fluxbb,fluxff,fluxbcbb,fluxbcff,fluxbcnff)
363	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcba
364	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbc
365	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxombb
366	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomff
367	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnff
368	!$OMP THREADPRIVATE(fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff)
369	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomba
370	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnat
371	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxom
372	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sff
373	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2snff
374	!$OMP THREADPRIVATE(fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff)
375	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ff
376	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2nff
377	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2bb
378	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2vol
379	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ba
380	!$OMP THREADPRIVATE(fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba)
381	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2
382	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ff
383	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4nff
384	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4bb
385	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ba
386	!$OMP THREADPRIVATE(fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb)
387	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4
388	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdms
389	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sbio
390	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdustec
391	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddfine
392	!$OMP THREADPRIVATE(fluxso4,fluxdms,fluxh2sbio,fluxdustec,fluxddfine)
393	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddcoa
394	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddsco
395	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdd
396	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxssfine
397	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxsscoa
398	!$OMP THREADPRIVATE(fluxddcoa,fluxddsco,fluxdd,fluxssfine,fluxsscoa)
399	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxss
400	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ind
401	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_bb
402	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ff
403	!$OMP THREADPRIVATE(fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff)
404	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddfine
405	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddcoa
406	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddsco
407	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ssfine
408	!$OMP THREADPRIVATE(flux_sparam_ddfine,flux_sparam_ddcoa)
409	!$OMP THREADPRIVATE(flux_sparam_ddsco,flux_sparam_ssfine)
410	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_sscoa
411	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: u10m_ss
412	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: v10m_ss
413	!$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss)
414
415	! Select dust emission scheme for the Sahara:
416	! LOGICAL,PARAMETER,SAVE :: ok_chimeredust=.FALSE.
417	LOGICAL, PARAMETER :: ok_chimeredust = .TRUE.
418	!!!!!! !$OMP THREADPRIVATE(ok_chimeredust)
419
420
421	CONTAINS
422
423	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
424	SUBROUTINE phytracr_spl_out_init()
425	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
426	!AS : This subroutine centralises the ALLOCATE needed for the 1st call of
427	! phys_output_write_spl in physiq
428
429	USE dimphy
430	USE infotrac_phy, ONLY : nbtr
431	USE dustemission_mod, ONLY : dustemis_out_init
432
433	! pour les variables m[1-3]dflux
434	CALL dustemis_out_init()
435
436	!traceur
437	ALLOCATE(diff_aod550_tot(klon))
438	ALLOCATE(diag_aod670_tot(klon))
439	ALLOCATE(diag_aod865_tot(klon))
440	ALLOCATE(diff_aod550_tr2(klon))
441	ALLOCATE(diag_aod670_tr2(klon))
442	ALLOCATE(diag_aod865_tr2(klon))
443	ALLOCATE(diag_aod550_ss(klon))
444	ALLOCATE(diag_aod670_ss(klon))
445	ALLOCATE(diag_aod865_ss(klon))
446	ALLOCATE(diag_aod550_dust(klon))
447	ALLOCATE(diag_aod670_dust(klon))
448	ALLOCATE(diag_aod865_dust(klon))
449	ALLOCATE(diag_aod550_dustsco(klon))
450	ALLOCATE(diag_aod670_dustsco(klon))
451	ALLOCATE(diag_aod865_dustsco(klon))
452	!AS: les 15 vars _terra et 15 _aqua suivantes sont groupees differemment dans spla_output_write.h
453	ALLOCATE(aod550_terra(klon))
454	ALLOCATE(aod550_tr2_terra(klon))
455	ALLOCATE(aod550_ss_terra(klon))
456	ALLOCATE(aod550_dust_terra(klon))
457	ALLOCATE(aod550_dustsco_terra(klon))
458	ALLOCATE(aod670_terra(klon))
459	ALLOCATE(aod670_tr2_terra(klon))
460	ALLOCATE(aod670_ss_terra(klon))
461	ALLOCATE(aod670_dust_terra(klon))
462	ALLOCATE(aod670_dustsco_terra(klon))
463	ALLOCATE(aod865_terra(klon))
464	ALLOCATE(aod865_tr2_terra(klon))
465	ALLOCATE(aod865_ss_terra(klon))
466	ALLOCATE(aod865_dust_terra(klon))
467	ALLOCATE(aod865_dustsco_terra(klon))
468
469	ALLOCATE(aod550_aqua(klon))
470	ALLOCATE(aod550_tr2_aqua(klon))
471	ALLOCATE(aod550_ss_aqua(klon))
472	ALLOCATE(aod550_dust_aqua(klon))
473	ALLOCATE(aod550_dustsco_aqua(klon))
474	ALLOCATE(aod670_aqua(klon))
475	ALLOCATE(aod670_tr2_aqua(klon))
476	ALLOCATE(aod670_ss_aqua(klon))
477	ALLOCATE(aod670_dust_aqua(klon))
478	ALLOCATE(aod670_dustsco_aqua(klon))
479	ALLOCATE(aod865_aqua(klon))
480	ALLOCATE(aod865_tr2_aqua(klon))
481	ALLOCATE(aod865_ss_aqua(klon))
482	ALLOCATE(aod865_dust_aqua(klon))
483	ALLOCATE(aod865_dustsco_aqua(klon))
484
485	ALLOCATE(sconc01(klon))
486	ALLOCATE(trm01(klon))
487	ALLOCATE(sconc02(klon))
488	ALLOCATE(trm02(klon))
489	ALLOCATE(sconc03(klon))
490	ALLOCATE(trm03(klon))
491	ALLOCATE(sconc04(klon))
492	ALLOCATE(trm04(klon))
493	ALLOCATE(sconc05(klon))
494	ALLOCATE(trm05(klon))
495
496	! Lessivage
497	ALLOCATE(flux01(klon))
498	ALLOCATE(flux02(klon))
499	ALLOCATE(flux03(klon))
500	ALLOCATE(flux04(klon))
501	ALLOCATE(flux05(klon))
502	ALLOCATE(ds01(klon))
503	ALLOCATE(ds02(klon))
504	ALLOCATE(ds03(klon))
505	ALLOCATE(ds04(klon))
506	ALLOCATE(ds05(klon))
507	ALLOCATE(dh01(klon))
508	ALLOCATE(dh02(klon))
509	ALLOCATE(dh03(klon))
510	ALLOCATE(dh04(klon))
511	ALLOCATE(dh05(klon))
512	ALLOCATE(dtrconv01(klon))
513	ALLOCATE(dtrconv02(klon))
514	ALLOCATE(dtrconv03(klon))
515	ALLOCATE(dtrconv04(klon))
516	ALLOCATE(dtrconv05(klon))
517	ALLOCATE(dtherm01(klon))
518	ALLOCATE(dtherm02(klon))
519	ALLOCATE(dtherm03(klon))
520	ALLOCATE(dtherm04(klon))
521	ALLOCATE(dtherm05(klon))
522	ALLOCATE(dhkecv01(klon))
523	ALLOCATE(dhkecv02(klon))
524	ALLOCATE(dhkecv03(klon))
525	ALLOCATE(dhkecv04(klon))
526	ALLOCATE(dhkecv05(klon))
527	ALLOCATE(d_tr_ds01(klon))
528	ALLOCATE(d_tr_ds02(klon))
529	ALLOCATE(d_tr_ds03(klon))
530	ALLOCATE(d_tr_ds04(klon))
531	ALLOCATE(d_tr_ds05(klon))
532	ALLOCATE(dhkelsc01(klon))
533	ALLOCATE(dhkelsc02(klon))
534	ALLOCATE(dhkelsc03(klon))
535	ALLOCATE(dhkelsc04(klon))
536	ALLOCATE(dhkelsc05(klon))
537	ALLOCATE(d_tr_cv01(klon, klev))
538	ALLOCATE(d_tr_cv02(klon, klev))
539	ALLOCATE(d_tr_cv03(klon, klev))
540	ALLOCATE(d_tr_cv04(klon, klev))
541	ALLOCATE(d_tr_cv05(klon, klev))
542	ALLOCATE(d_tr_trsp01(klon, klev))
543	ALLOCATE(d_tr_trsp02(klon, klev))
544	ALLOCATE(d_tr_trsp03(klon, klev))
545	ALLOCATE(d_tr_trsp04(klon, klev))
546	ALLOCATE(d_tr_trsp05(klon, klev))
547	ALLOCATE(d_tr_sscav01(klon, klev))
548	ALLOCATE(d_tr_sscav02(klon, klev))
549	ALLOCATE(d_tr_sscav03(klon, klev))
550	ALLOCATE(d_tr_sscav04(klon, klev))
551	ALLOCATE(d_tr_sscav05(klon, klev))
552	ALLOCATE(d_tr_sat01(klon, klev))
553	ALLOCATE(d_tr_sat02(klon, klev))
554	ALLOCATE(d_tr_sat03(klon, klev))
555	ALLOCATE(d_tr_sat04(klon, klev))
556	ALLOCATE(d_tr_sat05(klon, klev))
557	ALLOCATE(d_tr_uscav01(klon, klev))
558	ALLOCATE(d_tr_uscav02(klon, klev))
559	ALLOCATE(d_tr_uscav03(klon, klev))
560	ALLOCATE(d_tr_uscav04(klon, klev))
561	ALLOCATE(d_tr_uscav05(klon, klev))
562	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
563	ALLOCATE(d_tr_insc01(klon, klev))
564	ALLOCATE(d_tr_insc02(klon, klev))
565	ALLOCATE(d_tr_insc03(klon, klev))
566	ALLOCATE(d_tr_insc04(klon, klev))
567	ALLOCATE(d_tr_insc05(klon, klev))
568	ALLOCATE(d_tr_bcscav01(klon, klev))
569	ALLOCATE(d_tr_bcscav02(klon, klev))
570	ALLOCATE(d_tr_bcscav03(klon, klev))
571	ALLOCATE(d_tr_bcscav04(klon, klev))
572	ALLOCATE(d_tr_bcscav05(klon, klev))
573	ALLOCATE(d_tr_evapls01(klon, klev))
574	ALLOCATE(d_tr_evapls02(klon, klev))
575	ALLOCATE(d_tr_evapls03(klon, klev))
576	ALLOCATE(d_tr_evapls04(klon, klev))
577	ALLOCATE(d_tr_evapls05(klon, klev))
578	ALLOCATE(d_tr_ls01(klon, klev))
579	ALLOCATE(d_tr_ls02(klon, klev))
580	ALLOCATE(d_tr_ls03(klon, klev))
581	ALLOCATE(d_tr_ls04(klon, klev))
582	ALLOCATE(d_tr_ls05(klon, klev))
583
584	ALLOCATE(d_tr_dyn01(klon, klev))
585	ALLOCATE(d_tr_dyn02(klon, klev))
586	ALLOCATE(d_tr_dyn03(klon, klev))
587	ALLOCATE(d_tr_dyn04(klon, klev))
588	ALLOCATE(d_tr_dyn05(klon, klev))
589
590	ALLOCATE(d_tr_cl01(klon, klev))
591	ALLOCATE(d_tr_cl02(klon, klev))
592	ALLOCATE(d_tr_cl03(klon, klev))
593	ALLOCATE(d_tr_cl04(klon, klev))
594	ALLOCATE(d_tr_cl05(klon, klev))
595	ALLOCATE(d_tr_th01(klon, klev))
596	ALLOCATE(d_tr_th02(klon, klev))
597	ALLOCATE(d_tr_th03(klon, klev))
598	ALLOCATE(d_tr_th04(klon, klev))
599	ALLOCATE(d_tr_th05(klon, klev))
600
601	ALLOCATE(sed_ss(klon))
602	ALLOCATE(sed_dust(klon))
603	ALLOCATE(sed_dustsco(klon))
604	ALLOCATE(his_g2pgas(klon))
605	ALLOCATE(his_g2paer(klon))
606
607	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
608	ALLOCATE(sed_ss3D(klon, klev))
609	ALLOCATE(sed_dust3D(klon, klev))
610	ALLOCATE(sed_dustsco3D(klon, klev))
611	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
612
613	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
614	! histrac_spl
615
616	ALLOCATE(fluxbb(klon))
617	ALLOCATE(fluxff(klon))
618	ALLOCATE(fluxbcbb(klon))
619	ALLOCATE(fluxbcff(klon))
620	ALLOCATE(fluxbcnff(klon))
621	ALLOCATE(fluxbcba(klon))
622	ALLOCATE(fluxbc(klon))
623	ALLOCATE(fluxombb(klon))
624	ALLOCATE(fluxomff(klon))
625	ALLOCATE(fluxomnff(klon))
626	ALLOCATE(fluxomba(klon))
627	ALLOCATE(fluxomnat(klon))
628	ALLOCATE(fluxom(klon))
629	ALLOCATE(fluxh2sff(klon))
630	ALLOCATE(fluxh2snff(klon))
631	ALLOCATE(fluxso2ff(klon))
632	ALLOCATE(fluxso2nff(klon))
633	ALLOCATE(fluxso2bb(klon))
634	ALLOCATE(fluxso2vol(klon))
635	ALLOCATE(fluxso2ba(klon))
636	ALLOCATE(fluxso2(klon))
637	ALLOCATE(fluxso4ff(klon))
638	ALLOCATE(fluxso4nff(klon))
639	ALLOCATE(fluxso4bb(klon))
640	ALLOCATE(fluxso4ba(klon))
641	ALLOCATE(fluxso4(klon))
642	ALLOCATE(fluxdms(klon))
643	ALLOCATE(fluxh2sbio(klon))
644	ALLOCATE(fluxdustec(klon))
645	ALLOCATE(fluxddfine(klon))
646	ALLOCATE(fluxddcoa(klon))
647	ALLOCATE(fluxddsco(klon))
648	ALLOCATE(fluxdd(klon))
649	ALLOCATE(fluxssfine(klon))
650	ALLOCATE(fluxsscoa(klon))
651	ALLOCATE(fluxss(klon))
652	ALLOCATE(flux_sparam_ind(klon))
653	ALLOCATE(flux_sparam_bb(klon))
654	ALLOCATE(flux_sparam_ff(klon))
655	ALLOCATE(flux_sparam_ddfine(klon))
656	ALLOCATE(flux_sparam_ddcoa(klon))
657	ALLOCATE(flux_sparam_ddsco(klon))
658	ALLOCATE(flux_sparam_ssfine(klon))
659	ALLOCATE(flux_sparam_sscoa(klon))
660	ALLOCATE(u10m_ss(klon))
661	ALLOCATE(v10m_ss(klon))
662
663	!AS: in phys_output_write_spl, but not in spla_output_write.h
664	!------------------------------------------------------
665	ALLOCATE(d_tr_cl(klon, klev, nbtr))
666	ALLOCATE(d_tr_th(klon, klev, nbtr))
667	ALLOCATE(d_tr_cv(klon, klev, nbtr))
668	ALLOCATE(d_tr_lessi_impa(klon, klev, nbtr))
669	ALLOCATE(d_tr_lessi_nucl(klon, klev, nbtr))
670	ALLOCATE(d_tr_insc(klon, klev, nbtr))
671	ALLOCATE(d_tr_bcscav(klon, klev, nbtr))
672	ALLOCATE(d_tr_evapls(klon, klev, nbtr))
673	ALLOCATE(d_tr_ls(klon, klev, nbtr))
674	ALLOCATE(d_tr_trsp(klon, klev, nbtr))
675	ALLOCATE(d_tr_sscav(klon, klev, nbtr))
676	ALLOCATE(d_tr_sat(klon, klev, nbtr))
677	ALLOCATE(d_tr_uscav(klon, klev, nbtr))
678
679	END SUBROUTINE phytracr_spl_out_init
680
681	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
682	SUBROUTINE phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
683	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
684
685	IMPLICIT NONE
686	INTEGER klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust
687
688	ALLOCATE(tsol(klon))
689
690	!AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
691	! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
692	! avant d'appeler la subroutine presente, phytracr_spl_ini
693	! (phytracr_spl_ini appele readregionsdims2_spl,
694	! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
695	IF("ASSIM"=="YES") THEN
696	fileregionsdimsind = 'regions_ind_meta'
697	fileregionsdimsdust = 'regions_dustacc_meta'
698	! fileregionsdimsdust='regions_dust_meta'
699	fileregionsdimsbb = 'regions_bb_meta'
700	fileregionsdimswstar = 'regions_pwstarwake_meta'
701	call readregionsdims2_spl(nbreg_ind, fileregionsdimsind)
702	call readregionsdims2_spl(nbreg_dust, fileregionsdimsdust)
703	call readregionsdims2_spl(nbreg_bb, fileregionsdimsbb)
704	call readregionsdims2_spl(nbreg_wstardust, fileregionsdimswstar)
705	ENDIF ! ASSIM
706	! fin debranchage
707
708	!readregions_spl()
709
710	ALLOCATE(scale_param_ind(nbreg_ind))
711	ALLOCATE(scale_param_bb(nbreg_bb))
712	ALLOCATE(scale_param_ff(nbreg_ind))
713	ALLOCATE(scale_param_dustacc(nbreg_dust))
714	ALLOCATE(scale_param_dustcoa(nbreg_dust))
715	ALLOCATE(scale_param_dustsco(nbreg_dust))
716	ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
717	ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
718	ALLOCATE(dust_ec(klon))
719	ALLOCATE(u10m_ec(klon))
720	ALLOCATE(v10m_ec(klon))
721	ALLOCATE(lmt_so2volc_cont(klon))
722	ALLOCATE(lmt_altvolc_cont(klon))
723	ALLOCATE(lmt_so2volc_expl(klon))
724	ALLOCATE(lmt_altvolc_expl(klon))
725	ALLOCATE(lmt_so2ff_l(klon))
726	ALLOCATE(lmt_so2ff_h(klon))
727	ALLOCATE(lmt_so2nff(klon))
728	ALLOCATE(lmt_so2ba(klon))
729	ALLOCATE(lmt_so2bb_l(klon))
730	ALLOCATE(lmt_so2bb_h(klon))
731	ALLOCATE(lmt_dmsconc(klon))
732	ALLOCATE(lmt_dmsbio(klon))
733	ALLOCATE(lmt_h2sbio(klon))
734	ALLOCATE(lmt_bcff(klon))
735	ALLOCATE(lmt_bcnff(klon))
736	ALLOCATE(lmt_bcbb_l(klon))
737	ALLOCATE(lmt_bcbb_h(klon))
738	ALLOCATE(lmt_bcba(klon))
739	ALLOCATE(lmt_omff(klon))
740	ALLOCATE(lmt_omnff(klon))
741	ALLOCATE(lmt_ombb_l(klon))
742	ALLOCATE(lmt_ombb_h(klon))
743	ALLOCATE(lmt_omnat(klon))
744	ALLOCATE(lmt_omba(klon))
745	ALLOCATE(lmt_sea_salt(klon, ss_bins))
746
747
748
749
750	!temporal hardcoded null inicialization of assimilation emmision factors
751	!AS: scale_param sont ensuite lus dans modvalues.nc
752	! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
753	scale_param_ssacc = 1.
754	scale_param_sscoa = 1.
755	scale_param_ind(:) = 1.
756	scale_param_bb(:) = 1.
757	scale_param_ff(:) = 1.
758	scale_param_dustacc(:) = 1.
759	scale_param_dustcoa(:) = 1.
760	scale_param_dustsco(:) = 1.
761	param_wstarBLperregion(:) = 0.
762	param_wstarWAKEperregion(:) = 0.
763
764	RETURN
765	END SUBROUTINE phytracr_spl_ini
766
767
768	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
769	SUBROUTINE phytracr_spl (debutphy, lafin, jD_cur, jH_cur, iflag_conv, & ! I
770	pdtphys, ftsol, & ! I
771	t_seri, q_seri, paprs, pplay, RHcl, & ! I
772	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & ! I
773	coefh, cdragh, cdragm, yu1, yv1, & ! I
774	u_seri, v_seri, rlat, rlon, & ! I
775	pphis, pctsrf, pmflxr, pmflxs, prfl, psfl, & ! I
776	da, phi, phi2, d1a, dam, mp, ep, sigd, sij, clw, elij, & ! I
777	epmlmMm, eplaMm, upwd, dnwd, itop_con, ibas_con, & ! I
778	evapls, wdtrainA, wdtrainM, wght_cvfd, & ! I
779	fm_therm, entr_therm, rneb, & ! I
780	beta_fisrt, beta_v1, & ! I
781	zu10m, zv10m, wstar, ale_bl, ale_wake, & ! I
782	d_tr_dyn, tr_seri) ! O
783	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
784
785	USE mod_grid_phy_lmdz
786	USE mod_phys_lmdz_para
787	USE IOIPSL
788	USE dimphy
789	USE infotrac
790	USE indice_sol_mod
791	USE write_field_phy
792
793	USE mod_phys_lmdz_transfert_para
794	USE lmdz_thermcell_dq, ONLY : thermcell_dq
795	USE phys_cal_mod, only : jD_1jan, year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
796	mth_cur, phys_cal_update
797
798	USE lmdz_yomcst
799
800	IMPLICIT none
801
802	!======================================================================
803	! Auteur(s) FH
804	! Objet: Moniteur general des tendances traceurs
805
806	! Remarques en vrac:
807	! ------------------
808	! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien
809	! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
810	!! AS : nqmax-2 devrait etre nqmax-3 apres introducton de H2Oi ;
811	!! et c'est encore different avec le parser de DC ?
812	!======================================================================
813	INCLUDE "dimensions.h"
814	INCLUDE "chem.h"
815	INCLUDE "chem_spla.h"
816	INCLUDE "YOETHF.h"
817	INCLUDE "paramet.h"
818	INCLUDE "alpale.h"
819
820	!======================================================================
821
822	! Arguments:
823
824	! EN ENTREE:
825	! ==========
826
827	! divers:
828	! -------
829
830	real, intent(in) :: pdtphys ! pas d'integration pour la physique (seconde)
831	REAL, intent(in) :: jD_cur, jH_cur
832	real, intent(in) :: ftsol(klon, nbsrf) ! temperature du sol par type
833	real, intent(in) :: t_seri(klon, klev) ! temperature
834	real, intent(in) :: u_seri(klon, klev) ! vent
835	real, intent(in) :: v_seri(klon, klev) ! vent
836	real, intent(in) :: q_seri(klon, klev) ! vapeur d eau kg/kg
837
838	LOGICAL, INTENT(IN) :: lafin
839
840	real tr_seri(klon, klev, nbtr) ! traceur
841	real tmp_var(klon, klev) ! auxiliary variable to replace traceur
842	real tmp_var2(klon, nbtr) ! auxiliary variable to replace source
843	real tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
844	real dummy1d ! JE auxiliary variable
845	real aux_var2(klon) ! auxiliary variable to replace traceur
846	real aux_var3(klon, klev) ! auxiliary variable to replace traceur
847	real d_tr(klon, klev, nbtr) ! traceur tendance
848	real sconc_seri(klon, nbtr) ! surface concentration of traceur
849
850	integer nbjour
851	save nbjour
852	!$OMP THREADPRIVATE(nbjour)
853
854	INTEGER masque_aqua_cur(klon)
855	INTEGER masque_terra_cur(klon)
856	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua !mask for 1 day
857	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
858	!$OMP THREADPRIVATE(masque_aqua,masque_terra)
859
860	INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss, nbreg_wstardust
861	!$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
862
863	REAL lmt_dms(klon) ! emissions de dms
864
865	!JE20150518<<
866	REAL, DIMENSION(klon_glo) :: aod550_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
867	REAL, DIMENSION(klon_glo) :: aod550_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
868	REAL, DIMENSION(klon_glo) :: aod550_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
869	REAL, DIMENSION(klon_glo) :: aod550_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
870	REAL, DIMENSION(klon_glo) :: aod550_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
871	REAL, DIMENSION(klon_glo) :: aod670_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
872	REAL, DIMENSION(klon_glo) :: aod670_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
873	REAL, DIMENSION(klon_glo) :: aod670_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
874	REAL, DIMENSION(klon_glo) :: aod670_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
875	REAL, DIMENSION(klon_glo) :: aod670_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
876	REAL, DIMENSION(klon_glo) :: aod865_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
877	REAL, DIMENSION(klon_glo) :: aod865_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
878	REAL, DIMENSION(klon_glo) :: aod865_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
879	REAL, DIMENSION(klon_glo) :: aod865_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
880	REAL, DIMENSION(klon_glo) :: aod865_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
881
882	REAL, DIMENSION(klon_glo) :: aod550_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
883	REAL, DIMENSION(klon_glo) :: aod550_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
884	REAL, DIMENSION(klon_glo) :: aod550_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
885	REAL, DIMENSION(klon_glo) :: aod550_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
886	REAL, DIMENSION(klon_glo) :: aod550_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
887	REAL, DIMENSION(klon_glo) :: aod670_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
888	REAL, DIMENSION(klon_glo) :: aod670_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
889	REAL, DIMENSION(klon_glo) :: aod670_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
890	REAL, DIMENSION(klon_glo) :: aod670_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
891	REAL, DIMENSION(klon_glo) :: aod670_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
892	REAL, DIMENSION(klon_glo) :: aod865_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
893	REAL, DIMENSION(klon_glo) :: aod865_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
894	REAL, DIMENSION(klon_glo) :: aod865_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
895	REAL, DIMENSION(klon_glo) :: aod865_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
896	REAL, DIMENSION(klon_glo) :: aod865_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
897	!!!!!!!!!!!!!
898	!JE20150518>>
899
900	real, intent(in) :: paprs(klon, klev + 1) ! pression pour chaque inter-couche (en Pa)
901	real, intent(in) :: pplay(klon, klev) ! pression pour le mileu de chaque couche (en Pa)
902	real, intent(in) :: RHcl(klon, klev) ! humidite relativen ciel clair
903	real znivsig(klev) ! indice des couches
904	real paire(klon)
905	real, intent(in) :: pphis(klon)
906	real, intent(in) :: pctsrf(klon, nbsrf)
907	logical, intent(in) :: debutphy ! le flag de l'initialisation de la physique
908
909	! Scaling Parameters:
910	! ----------------------
911
912	CHARACTER*50 c_Directory
913	CHARACTER*80 c_FileName1
914	CHARACTER*80 c_FileName2
915	CHARACTER*130 c_FullName1
916	CHARACTER*130 c_FullName2
917	INTEGER :: xidx, yidx
918	INTEGER, DIMENSION(klon) :: mask_bbreg
919	INTEGER, DIMENSION(klon) :: mask_ffso2reg
920	INTEGER :: aux_mask1
921	INTEGER :: aux_mask2
922	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
923	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind !Defines regions for SO2, BC & OM
924	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb !Defines regions for SO2, BC & OM
925	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines dust regions
926	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines dust regions
927	!$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
928
929	! Emissions:
930
931	!---------------------------- SEA SALT & DUST emissions ------------------------
932	REAL lmt_sea_salt(klon, ss_bins) !Sea salt 0.03-8.0 um
933	REAL u10m_ec1(klon), v10m_ec1(klon)
934	REAL u10m_ec2(klon), v10m_ec2(klon), dust_ec2(klon)
935	REAL dust_ec(klon)
936	! new dust emission chimere je20140522
937	REAL, DIMENSION(klon), INTENT(IN) :: zu10m
938	REAL, DIMENSION(klon), INTENT(IN) :: zv10m
939	REAL, DIMENSION(klon), INTENT(IN) :: wstar, ale_bl, ale_wake
940
941	! Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
942
943	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
944	!Dynamique
945	!--------
946	REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: d_tr_dyn
947
948	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
949	! convection:
950	! -----------
951
952	REAL, intent(in) :: pmfu(klon, klev) ! flux de masse dans le panache montant
953	REAL, intent(in) :: pmfd(klon, klev) ! flux de masse dans le panache descendant
954	REAL, intent(in) :: pen_u(klon, klev) ! flux entraine dans le panache montant
955	REAL, intent(in) :: pde_u(klon, klev) ! flux detraine dans le panache montant
956	REAL, intent(in) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
957	REAL, intent(in) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
958
959	! Convection KE scheme:
960	! ---------------------
961
962	!! Variables pour le lessivage convectif
963	REAL, DIMENSION(klon, klev), INTENT(IN) :: da
964	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi
965	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi2
966	REAL, DIMENSION(klon, klev), INTENT(IN) :: d1a, dam
967	REAL, DIMENSION(klon, klev), INTENT(IN) :: mp
968	REAL, DIMENSION(klon, klev), INTENT(IN) :: upwd ! saturated
969	! updraft mass flux
970	REAL, DIMENSION(klon, klev), INTENT(IN) :: dnwd ! saturated
971	! downdraft mass flux
972	INTEGER, DIMENSION(klon), INTENT(IN) :: itop_con
973	INTEGER, DIMENSION(klon), INTENT(IN) :: ibas_con
974	REAL, DIMENSION(klon, klev) :: evapls
975	REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainA
976	REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainM
977
978	REAL, DIMENSION(klon, klev), INTENT(IN) :: ep
979	REAL, DIMENSION(klon), INTENT(IN) :: sigd
980	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: sij
981	REAL, DIMENSION(klon, klev), INTENT(IN) :: clw
982	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: elij
983	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: epmlmMm
984	REAL, DIMENSION(klon, klev), INTENT(IN) :: eplaMm
985	REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_cvfd !RL
986
987
988	! KE: Tendances de traceurs (Td) et flux de traceurs:
989	! ------------------------
990	REAL, DIMENSION(klon, klev) :: Mint
991	REAL, DIMENSION(klon, klev, nbtr) :: zmfd1a
992	REAL, DIMENSION(klon, klev, nbtr) :: zmfdam
993	REAL, DIMENSION(klon, klev, nbtr) :: zmfphi2
994
995	! !tra dans pluie LS a la surf.
996	! outputs for cvltr_spl
997	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv_o
998	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp_o
999	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav_o
1000	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat_o
1001	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav_o
1002	!!!!!!!!!!!!!!!!!
1003	!!!!!!!!!!!!!!!!!
1004	!!!!!!!!!!!!!!!!!
1005	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc_o
1006	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav_o
1007	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls_o
1008	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls_o
1009	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dyn_o
1010	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl_o
1011	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th_o
1012	!!!!!!!!!!!!!!!!!
1013	!!!!!!!!!!!!!!!!!
1014	!!!!!!!!!!!!!!!!!
1015
1016	!$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
1017	!$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
1018	!$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
1019
1020	INTEGER :: nsplit
1021
1022	! Lessivage
1023	! ---------
1024
1025	REAL, intent(in) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1) !--convection
1026	REAL, intent(in) :: prfl(klon, klev + 1), psfl(klon, klev + 1) !--large-scale
1027	REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
1028	REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
1029
1030	REAL, DIMENSION(klon, klev), INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
1031
1032	REAL, DIMENSION(klon, klev) :: beta_fisrt ! taux de conversion
1033	! ! de l'eau cond (de fisrtilp)
1034	REAL, DIMENSION(klon, klev) :: beta_v1 ! -- (originale version)
1035	INTEGER, SAVE :: iflag_lscav_omp, iflag_lscav
1036	!$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
1037
1038
1039
1040
1041	!Thermiques:
1042	!----------
1043	REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: fm_therm
1044	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: entr_therm
1045
1046	! Couche limite:
1047	! --------------
1048
1049	REAL, intent(in) :: coefh(klon, klev) ! coeff melange CL
1050	REAL, intent(in) :: cdragh(klon), cdragm(klon)
1051	REAL, intent(in) :: yu1(klon) ! vent dans la 1iere couche
1052	REAL, intent(in) :: yv1(klon) ! vent dans la 1iere couche
1053
1054
1055	!----------------------------------------------------------------------
1056	REAL his_ds(klon, nbtr)
1057	REAL his_dh(klon, nbtr)
1058	REAL his_dhlsc(klon, nbtr) ! in-cloud scavenging lsc
1059	REAL his_dhcon(klon, nbtr) ! in-cloud scavenging con
1060	REAL his_dhbclsc(klon, nbtr) ! below-cloud scavenging lsc
1061	REAL his_dhbccon(klon, nbtr) ! below-cloud scavenging con
1062	REAL trm(klon, nbtr)
1063
1064	REAL u10m_ec(klon), v10m_ec(klon)
1065
1066	REAL his_th(klon, nbtr)
1067	REAL his_dhkecv(klon, nbtr)
1068	REAL his_dhkelsc(klon, nbtr)
1069
1070	! Coordonnees
1071	! -----------
1072
1073	REAL, intent(in) :: rlat(klon) ! latitudes pour chaque point
1074	REAL, intent(in) :: rlon(klon) ! longitudes pour chaque point
1075
1076	INTEGER i, k, iq, itr, j, ig
1077
1078	! DEFINITION OF DIAGNOSTIC VARIABLES
1079
1080	REAL diag_trm(nbtr), diag_drydep(nbtr)
1081	REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
1082	REAL diag_emissn(nbtr), diag_g2part
1083	REAL diag_sedimt
1084	REAL trm_aux(nbtr), src_aux(nbtr)
1085
1086	! Variables locales pour effectuer les appels en serie
1087	!----------------------------------------------------
1088	REAL source_tr(klon, nbtr)
1089	REAL flux_tr(klon, nbtr)
1090	REAL m_conc(klon, klev)
1091	REAL henry(nbtr) !--cste de Henry mol/l/atm
1092	REAL kk(nbtr) !--coefficient de var avec T (K)
1093	REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
1094	REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
1095	REAL vdep_oce(nbtr), vdep_sic(nbtr)
1096	REAL vdep_ter(nbtr), vdep_lic(nbtr)
1097	REAL ccntrAA_spla(nbtr)
1098	REAL ccntrENV_spla(nbtr)
1099	REAL coefcoli_spla(nbtr)
1100	REAL dtrconv(klon, nbtr)
1101	REAL zrho(klon, klev), zdz(klon, klev)
1102	REAL zalt(klon, klev)
1103	REAL, DIMENSION(klon, klev) :: zmasse ! densité atmosphérique
1104	! . Kg/m2
1105	REAL, DIMENSION(klon, klev) :: ztra_th
1106	REAL qmin, qmax, aux
1107	! PARAMETER (qmin=0.0, qmax=1.e33)
1108	PARAMETER (qmin = 1.e33, qmax = -1.e33)
1109
1110	! Variables to save data into file
1111	!----------------------------------
1112
1113	CHARACTER*2 str2
1114	!!AS: LOGICAL ok_histrac
1115	!!!JE2014124 PARAMETER (ok_histrac=.true.)
1116	!! PARAMETER (ok_histrac=.false.)
1117	INTEGER ndex2d(iim * (jjm + 1)), ndex3d(iim * (jjm + 1) * klev)
1118	INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
1119	INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
1120	SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
1121	!$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
1122	INTEGER itra
1123	SAVE itra ! compteur pour la physique
1124	!$OMP THREADPRIVATE(itra)
1125	INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
1126	SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
1127	!$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
1128	REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
1129	REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, klev)
1130	REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
1131	REAL zx_lon_glo(nbp_lon, nbp_lat), zx_lat_glo(nbp_lon, nbp_lat)
1132	REAL zsto, zout, zout_h, zout_m, zjulian
1133
1134	!------Molar Masses
1135	REAL masse(nbtr)
1136
1137	REAL fracso2emis !--fraction so2 emis en so2
1138	PARAMETER (fracso2emis = 0.95)
1139	REAL frach2sofso2 !--fraction h2s from so2
1140	PARAMETER (frach2sofso2 = 0.0426)
1141
1142	! Controles
1143	!-------------
1144	LOGICAL convection, lessivage, lminmax, lcheckmass
1145	DATA convection, lessivage, lminmax, lcheckmass &
1146	/.true., .true., .true., .false./
1147
1148	REAL xconv(nbtr)
1149
1150	LOGICAL anthropo, bateau, edgar
1151	DATA anthropo, bateau, edgar/.true., .true., .true./
1152
1153	!c bc_source
1154	INTEGER kminbc, kmaxbc
1155	!JE20150715 PARAMETER (kminbc=3, kmaxbc=5)
1156	PARAMETER (kminbc = 4, kmaxbc = 7)
1157
1158	REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
1159
1160	! JE for updating in cltrac
1161	REAL, DIMENSION(klon, klev) :: delp ! epaisseur de couche (Pa)
1162	!! JE for include gas to particle conversion in output
1163	! REAL his_g2pgas(klon) ! gastoparticle in gas units (check!)
1164	! REAL his_g2paer(klon) ! gastoparticle in aerosol units (check!)
1165
1166	INTEGER, intent(in) :: iflag_conv
1167	LOGICAL iscm3 ! debug variable. for checkmass ! JE
1168
1169	!------------------------------------------------------------------------
1170	! only to compute time consumption of each process
1171	!----
1172	INTEGER clock_start, clock_end, clock_rate, clock_start_spla
1173	INTEGER clock_end_outphytracr, clock_start_outphytracr
1174	INTEGER ti_init, dife, ti_inittype, ti_inittwrite
1175	INTEGER ti_spla, ti_emis, ti_depo, ti_cltr, ti_ther
1176	INTEGER ti_sedi, ti_gasp, ti_wetap, ti_cvltr, ti_lscs, ti_brop, ti_outs
1177	INTEGER ti_nophytracr, clock_per_max
1178	REAL tia_init, tia_inittype, tia_inittwrite
1179	REAL tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
1180	REAL tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
1181	REAL tia_brop, tia_outs
1182	REAL tia_nophytracr
1183
1184	SAVE tia_init, tia_inittype, tia_inittwrite
1185	SAVE tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
1186	SAVE tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
1187	SAVE tia_brop, tia_outs
1188	SAVE ti_nophytracr
1189	SAVE tia_nophytracr
1190	SAVE clock_end_outphytracr, clock_start_outphytracr
1191	SAVE clock_per_max
1192	LOGICAL logitime
1193	!$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
1194	!$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
1195	!$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
1196	!$OMP THREADPRIVATE(tia_brop,tia_outs)
1197	!$OMP THREADPRIVATE(ti_nophytracr)
1198	!$OMP THREADPRIVATE(tia_nophytracr)
1199	!$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
1200	!$OMP THREADPRIVATE(clock_per_max)
1201
1202	! utils parallelization
1203	REAL :: auxklon_glo(klon_glo)
1204	INTEGER :: iauxklon_glo(klon_glo)
1205	REAL, DIMENSION(klon_glo, nbp_lev) :: auxklonnbp_lev
1206	REAL, DIMENSION(klon_glo, nbp_lev, nbtr) :: auxklonklevnbtr_glo
1207	REAL, DIMENSION(nbp_lon, nbp_lat) :: zx_tmp_2d_glo
1208	REAL, DIMENSION(nbp_lon, nbp_lat, nbp_lev) :: zx_tmp_3d_glo
1209	REAL, DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
1210	REAL, DIMENSION(klon_glo, nbp_lev) :: zx_tmp_fi3d_glo
1211	REAL, DIMENSION(klon_glo, nbtr) :: auxklonnbtr_glo
1212
1213	source_tr = 0.
1214
1215	if (debutphy) then
1216	#ifdef IOPHYS_DUST
1217	CALL iophys_ini(pdtphys)
1218	#endif
1219	nbreg_ind = 1
1220	nbreg_bb = 1
1221	nbreg_dust = 1
1222	nbreg_wstardust = 1
1223	CALL phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
1224	endif
1225
1226
1227	#ifdef IOPHYS_DUST
1228	itr = 0
1229	DO iq = 1, nqtot
1230	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
1231	itr = itr+1
1232	write(str2,'(i2.2)') itrr
1233	call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
1234	enddo
1235	#endif
1236
1237
1238
1239
1240	ijulday = jD_cur - jD_1jan + 1
1241	nbjour = 1
1242
1243	paramname_ind = 'ind'
1244	paramname_bb = 'bb'
1245	paramname_ff = 'ind'
1246	paramname_dustacc = 'dustacc'
1247	paramname_dustcoa = 'dustcoasco'
1248	paramname_dustsco = 'dustcoasco'
1249	! paramname_dustacc='dust'
1250	! paramname_dustcoa='dust'
1251	! paramname_dustsco='dust'
1252	paramname_wstarBL = 'pwstarbl'
1253	paramname_wstarWAKE = 'pwstarwake'
1254	paramname_ssacc = 'ssacc'
1255	paramname_sscoa = 'sscoa'
1256
1257	filescaleparams = 'modvalues.nc'
1258	!AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
1259	IF("ASSIM"=="YES") THEN
1260	CALL readscaleparamsnc_spl(scale_param_ind, &
1261	nbreg_ind, paramname_ind, &
1262	scale_param_ff, nbreg_ind, paramname_ff, &
1263	scale_param_bb, nbreg_bb, paramname_bb, &
1264	scale_param_dustacc, nbreg_dust, paramname_dustacc, &
1265	scale_param_dustcoa, nbreg_dust, paramname_dustcoa, &
1266	scale_param_dustsco, nbreg_dust, paramname_dustsco, &
1267	param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
1268	param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
1269	scale_param_ssacc, paramname_ssacc, &
1270	scale_param_sscoa, paramname_sscoa, &
1271	filescaleparams, ijulday, jH_cur, pdtphys, debutphy)
1272	ENDIF ! ASSIM
1273	!AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
1274	! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
1275	! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
1276	!! add seasalt
1277
1278	print *, 'JE : check scale_params'
1279
1280	print *, 'nbreg_ind', nbreg_ind
1281	print *, 'nbreg_dust', nbreg_dust
1282	print *, 'nbreg_bb', nbreg_bb
1283	print *, 'ind', scale_param_ind
1284	print *, 'dustacc', scale_param_dustacc
1285	print *, 'dustcoa', scale_param_dustcoa
1286	print *, 'dustsco', scale_param_dustsco
1287	print *, 'wstardustBL', param_wstarBLperregion
1288	print *, 'wstardustWAKE', param_wstarWAKEperregion
1289	print *, 'ff', scale_param_ff
1290	print *, 'bb', scale_param_bb
1291	print *, 'ssacc', scale_param_ssacc
1292	print *, 'sscoa', scale_param_sscoa
1293
1294	print *, 'JE: before read_newemissions '
1295	print *, 'JE: jD_cur:', jD_cur, ' ijulday:', ijulday, ' jH_cur:', jH_cur, ' pdtphys:', pdtphys
1296	print *, 'JE: now read_newemissions:'
1297	!AS: La ligne suivante fait planter a l'execution : lmt_so2ff_l pas initialise
1298	! print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
1299	call read_newemissions(ijulday, jH_cur, edgar, flag_dms, debutphy, & !I
1300	pdtphys, lafin, nbjour, pctsrf, & !I
1301	t_seri, rlat, rlon, & !I
1302	pmflxr, pmflxs, prfl, psfl, & !I
1303	u10m_ec, v10m_ec, dust_ec, & !O
1304	lmt_sea_salt, lmt_so2ff_l, & !O
1305	lmt_so2ff_h, lmt_so2nff, & !O
1306	lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, & !O
1307	lmt_so2volc_cont, lmt_altvolc_cont, & !O
1308	lmt_so2volc_expl, lmt_altvolc_expl, & !O
1309	lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, & !O
1310	lmt_bcff, lmt_bcnff, lmt_bcbb_l, & !O
1311	lmt_bcbb_h, lmt_bcba, lmt_omff, & !O
1312	lmt_omnff, lmt_ombb_l, lmt_ombb_h, & !O
1313	lmt_omnat, lmt_omba) !O
1314
1315	print *, 'Check emissions'
1316	print *, 'lmt_so2ff_l', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
1317	print *, 'lmt_so2ff_h', MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
1318	print *, 'lmt_so2nff', MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
1319	print *, 'lmt_so2ba', MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
1320	print *, 'lmt_so2bb_l', MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
1321	print *, 'lmt_so2bb_h', MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
1322	print *, 'lmt_so2volc_cont', MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
1323	print *, 'lmt_altvolc_cont', MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
1324	print *, 'lmt_so2volc_expl', MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
1325	print *, 'lmt_altvolc_expl', MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
1326	print *, 'lmt_dmsbio', MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
1327	print *, 'lmt_h2sbio', MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
1328	print *, 'lmt_dmsconc', MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
1329	print *, 'lmt_bcff', MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
1330	print *, 'lmt_bcnff', MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
1331	print *, 'lmt_bcbb_l', MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
1332	print *, 'lmt_bcbb_h', MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
1333	print *, 'lmt_bcba', MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
1334	print *, 'lmt_omff', MINVAL(lmt_omff), MAXVAL(lmt_omff)
1335	print *, 'lmt_omnff', MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
1336	print *, 'lmt_ombb_l', MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
1337	print *, 'lmt_ombb_h', MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
1338	print *, 'lmt_omnat', MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
1339	print *, 'lmt_omba', MINVAL(lmt_omba), MAXVAL(lmt_omba)
1340	print *, 'JE iflag_con', iflag_conv
1341
1342
1343	!JE_dbg
1344	do i = 1, klon
1345	tsol(i) = 0.0
1346	do j = 1, nbsrf
1347	tsol(i) = tsol(i) + ftsol(i, j) * pctsrf(i, j)
1348	enddo
1349	enddo
1350
1351
1352	!======================================================================
1353	! INITIALISATIONS
1354	!======================================================================
1355	! CALL checknanqfi(da(:,:),1.,-1.,' da_ before
1356	! . phytracr_inphytracr')
1357
1358	! computing time
1359	! logitime=.true.
1360	logitime = .false.
1361	IF (logitime) THEN
1362	clock_start = 0
1363	clock_end = 0
1364	clock_rate = 0
1365	CALL SYSTEM_CLOCK(COUNT_RATE = clock_rate, COUNT_MAX = clock_per_max)
1366	CALL SYSTEM_CLOCK(COUNT = clock_start_spla)
1367	clock_start = clock_start_spla
1368	clock_end_outphytracr = clock_start_spla
1369	ENDIF
1370
1371
1372	! Definition of tracers index.
1373	print*, 'OK ON PASSSE BIEN LA'
1374	CALL minmaxsource(source_tr, qmin, qmax, 'A1 maxsource init phytracr')
1375
1376	IF (debutphy) THEN
1377	id_prec = -1
1378	id_fine = -1
1379	id_coss = -1
1380	id_codu = -1
1381	id_scdu = -1
1382	itr = 0
1383	do iq = 1, nqtot
1384	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
1385	itr = itr + 1
1386	print *, itr, TRIM(tracers(iq)%name)
1387	SELECT CASE(tracers(iq)%name)
1388	CASE('PREC'); id_prec = itr
1389	CASE('FINE'); id_fine = itr
1390	CASE('COSS'); id_coss = itr
1391	CASE('CODU'); id_codu = itr
1392	CASE('SCDU'); id_scdu = itr
1393	END SELECT
1394	enddo
1395	! check consistency with dust emission scheme:
1396	if (ok_chimeredust) then
1397	if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
1398	call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1)
1399	endif
1400	else
1401	if (id_scdu>0) then
1402	call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1)
1403	endif
1404	if ((id_codu <= 0) .or. (id_fine<=0)) then
1405	call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1)
1406	endif
1407	endif
1408
1409
1410	!print *,id_prec,id_fine,id_coss,id_codu,id_scdu
1411	ENDIF
1412
1413
1414
1415
1416
1417
1418	!---fraction of tracer that is convected (Tiedke)
1419	xconv(:) = 0.
1420	if(id_prec>0) xconv(id_prec) = 0.8
1421	if(id_fine>0) xconv(id_fine) = 0.5
1422	if(id_coss>0) xconv(id_coss) = 0.5
1423	if(id_codu>0) xconv(id_codu) = 0.6
1424	if(id_scdu>0) xconv(id_scdu) = 0.6 !!JE fix
1425
1426	masse(:) = 1.
1427	if(id_prec>0) masse(id_prec) = 32.
1428	if(id_fine>0) masse(id_fine) = 6.02e23
1429	if(id_coss>0) masse(id_coss) = 6.02e23
1430	if(id_codu>0) masse(id_codu) = 6.02e23
1431	if(id_scdu>0) masse(id_scdu) = 6.02e23
1432
1433	henry(:) = 0.
1434	if(id_prec>0) henry(id_prec) = 1.4
1435	if(id_fine>0) henry(id_fine) = 0.0
1436	if(id_coss>0) henry(id_coss) = 0.0
1437	if(id_codu>0) henry(id_codu) = 0.0
1438	if(id_scdu>0) henry(id_scdu) = 0.0
1439	!henry= (/1.4, 0.0, 0.0, 0.0/)
1440	kk(:) = 0.
1441	if(id_prec>0) kk(id_prec) = 2900.
1442	if(id_fine>0) kk(id_fine) = 0.0
1443	if(id_coss>0) kk(id_coss) = 0.0
1444	if(id_codu>0) kk(id_codu) = 0.0
1445	if(id_scdu>0) kk(id_scdu) = 0.0
1446	!kk = (/2900., 0., 0., 0./)
1447	alpha_r(:) = 0.
1448	if(id_prec>0) alpha_r(id_prec) = 0.0
1449	if(id_fine>0) alpha_r(id_fine) = 0.001
1450	if(id_coss>0) alpha_r(id_coss) = 0.001
1451	if(id_codu>0) alpha_r(id_codu) = 0.001
1452	if(id_scdu>0) alpha_r(id_scdu) = 0.001 !JE fix
1453	alpha_s(:) = 0.
1454	if(id_prec>0) alpha_s(id_prec) = 0.0
1455	if(id_fine>0) alpha_s(id_fine) = 0.01
1456	if(id_coss>0) alpha_s(id_coss) = 0.01
1457	if(id_codu>0) alpha_s(id_codu) = 0.01
1458	if(id_scdu>0) alpha_s(id_scdu) = 0.01 !JE fix
1459
1460	! alpha_r = (/0., 0.001, 0.001, 0.001/)
1461	! alpha_s = (/0., 0.01, 0.01, 0.01/)
1462
1463	! nhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
1464	! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
1465	!vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
1466	vdep_oce(:) = 0.
1467	if(id_prec>0) vdep_oce(id_prec) = 0.28
1468	if(id_fine>0) vdep_oce(id_fine) = 0.28
1469	if(id_coss>0) vdep_oce(id_coss) = 1.2
1470	if(id_codu>0) vdep_oce(id_codu) = 1.2
1471	if(id_scdu>0) vdep_oce(id_scdu) = 1.2
1472	vdep_sic(:) = 0.
1473	if(id_prec>0) vdep_sic(id_prec) = 0.2
1474	if(id_fine>0) vdep_sic(id_fine) = 0.17
1475	if(id_coss>0) vdep_sic(id_coss) = 1.2
1476	if(id_codu>0) vdep_sic(id_codu) = 1.2
1477	if(id_scdu>0) vdep_sic(id_scdu) = 1.2
1478
1479	!vdep_sic = (/0.2, 0.17, 1.2, 1.2/)
1480	!vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
1481	vdep_ter(:) = 0.
1482	if(id_prec>0) vdep_ter(id_prec) = 0.3
1483	if(id_fine>0) vdep_ter(id_fine) = 0.14
1484	if(id_coss>0) vdep_ter(id_coss) = 1.2
1485	if(id_codu>0) vdep_ter(id_codu) = 1.2
1486	if(id_scdu>0) vdep_ter(id_scdu) = 1.2
1487
1488	vdep_lic(:) = 0.
1489	if(id_prec>0) vdep_lic(id_prec) = 0.2
1490	if(id_fine>0) vdep_lic(id_fine) = 0.17
1491	if(id_coss>0) vdep_lic(id_coss) = 1.2
1492	if(id_codu>0) vdep_lic(id_codu) = 1.2
1493	if(id_scdu>0) vdep_lic(id_scdu) = 1.2
1494
1495
1496	! convective KE lessivage aer params:
1497	! AS: #DFB (Binta) a aussi teste ccntrAA_spla=ccntrENV_spla=0.9/1.0/0.9/0.9
1498	! mais effet negligeable sur l'AOD
1499	ccntrAA_spla(:) = 0.
1500	if(id_prec>0) ccntrAA_spla(id_prec) = -9999.
1501	if(id_fine>0) ccntrAA_spla(id_fine) = 0.7
1502	if(id_coss>0) ccntrAA_spla(id_coss) = 1.0
1503	if(id_codu>0) ccntrAA_spla(id_codu) = 0.7
1504	if(id_scdu>0) ccntrAA_spla(id_scdu) = 0.7
1505
1506	ccntrENV_spla(:) = 0.
1507	if(id_prec>0) ccntrENV_spla(id_prec) = -9999.
1508	if(id_fine>0) ccntrENV_spla(id_fine) = 0.7
1509	if(id_coss>0) ccntrENV_spla(id_coss) = 1.0
1510	if(id_codu>0) ccntrENV_spla(id_codu) = 0.7
1511	if(id_scdu>0) ccntrENV_spla(id_scdu) = 0.7
1512	! #DFB
1513	coefcoli_spla(:) = 0.
1514	if(id_prec>0) coefcoli_spla(id_prec) = -9999.
1515	if(id_fine>0) coefcoli_spla(id_fine) = 0.001
1516	if(id_coss>0) coefcoli_spla(id_coss) = 0.001
1517	if(id_codu>0) coefcoli_spla(id_codu) = 0.001
1518	if(id_scdu>0) coefcoli_spla(id_scdu) = 0.001
1519
1520	!vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
1521
1522	iscm3 = .false.
1523	if (debutphy) then
1524	!$OMP MASTER
1525	CALL suphel
1526	print *, 'let s check nbtr=', nbtr
1527	! JE before put in zero
1528	IF (lminmax) THEN
1529	DO itr = 1, nbtr
1530	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan init phytracr')
1531	ENDDO
1532	DO itr = 1, nbtr
1533	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'minmax init phytracr')
1534	ENDDO
1535	CALL minmaxsource(source_tr, qmin, qmax, 'maxsource init phytracr')
1536	ENDIF
1537	! JE initializon to cero the tracers
1538	! DO itr=1,nbtr
1539	! tr_seri(:,:,itr)=0.0
1540	! ENDDO
1541	! JE end
1542	! Initializing to zero tr_seri for comparison purposes
1543	! tr_seri(:,:,:)=0.0
1544
1545	! DO itr=1,nbtr
1546	! trm_aux(itr)=0.0
1547	! src_aux(itr)=0.0
1548	! diag_trm(itr)=0.0
1549	! diag_drydep(itr)=0.0
1550	! diag_wetdep(itr)=0.0
1551	! diag_cvtdep(itr)=0.0
1552	! diag_emissn(itr)=0.0
1553	! ENDDO
1554	! diag_g2part=0.0
1555	print *, 'PREPARE FILES TO SAVE VARIABLES'
1556
1557	nbjour = 30
1558	ecrit_tra = NINT(86400. / pdtphys) !--1-day average
1559	ecrit_tra_h = NINT(86400. / pdtphys * 0.25) !--6-hour average
1560	ecrit_tra_m = NINT(86400. / pdtphys * FLOAT(nbjour)) !--1-mth average
1561	print *, 'ecrit_tra=', pdtphys, ecrit_tra
1562
1563	!!AS deleting lines
1564	!! IF (ok_histrac) THEN
1565	!! IF (is_mpi_root .AND. is_omp_root) THEN
1566	!!-----many deleted lines----
1567	!!! nbjour=1
1568	!! ENDIF ! mpi root
1569	!! ENDIF !--ok_histrac
1570
1571	!$OMP END MASTER
1572	!$OMP BARRIER
1573	endif ! debutphy
1574
1575	!======================================================================
1576	! Initialisations
1577	!======================================================================
1578
1579
1580	! je KE init
1581	IF (debutphy) THEN
1582	!$OMP MASTER
1583
1584	ALLOCATE(d_tr_dry(klon, nbtr))
1585	ALLOCATE(flux_tr_dry(klon, nbtr), d_tr_dec(klon, klev, nbtr))
1586	ALLOCATE(qPrls(klon, nbtr), qPr(klon, klev, nbtr))
1587	ALLOCATE(qDi(klon, klev, nbtr))
1588	ALLOCATE(qPa(klon, klev, nbtr), qMel(klon, klev, nbtr))
1589	ALLOCATE(qTrdi(klon, klev, nbtr), dtrcvMA(klon, klev, nbtr))
1590
1591	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1592	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1593	ALLOCATE(d_tr_cv_o(klon, klev, nbtr))
1594	ALLOCATE(d_tr_trsp_o(klon, klev, nbtr))
1595	ALLOCATE(d_tr_sscav_o(klon, klev, nbtr), &
1596	d_tr_sat_o(klon, klev, nbtr))
1597	ALLOCATE(d_tr_uscav_o(klon, klev, nbtr))
1598
1599	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1600	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1601	ALLOCATE(d_tr_insc_o(klon, klev, nbtr))
1602	ALLOCATE(d_tr_bcscav_o(klon, klev, nbtr))
1603	ALLOCATE(d_tr_evapls_o(klon, klev, nbtr))
1604	ALLOCATE(d_tr_ls_o(klon, klev, nbtr))
1605	ALLOCATE(d_tr_dyn_o(klon, klev, nbtr))
1606	ALLOCATE(d_tr_cl_o(klon, klev, nbtr))
1607	ALLOCATE(d_tr_th_o(klon, klev, nbtr))
1608	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1609	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1610	ALLOCATE(iregion_so4(klon))
1611	ALLOCATE(iregion_bb(klon))
1612	ALLOCATE(iregion_ind(klon))
1613	ALLOCATE(iregion_dust(klon))
1614	ALLOCATE(iregion_wstardust(klon))
1615
1616	!JE20150518<<
1617	ALLOCATE(masque_aqua(klon))
1618	ALLOCATE(masque_terra(klon))
1619
1620	masque_aqua(:) = 0
1621	masque_terra(:) = 0
1622
1623	aod550_terra(:) = 0.
1624	aod550_tr2_terra(:) = 0.
1625	aod550_ss_terra(:) = 0.
1626	aod550_dust_terra(:) = 0.
1627	aod550_dustsco_terra(:) = 0.
1628	aod670_terra(:) = 0.
1629	aod670_tr2_terra(:) = 0.
1630	aod670_ss_terra(:) = 0.
1631	aod670_dust_terra(:) = 0.
1632	aod670_dustsco_terra(:) = 0.
1633	aod865_terra(:) = 0.
1634	aod865_tr2_terra(:) = 0.
1635	aod865_ss_terra(:) = 0.
1636	aod865_dust_terra(:) = 0.
1637	aod865_dustsco_terra(:) = 0.
1638	aod550_aqua(:) = 0.
1639	aod550_tr2_aqua(:) = 0.
1640	aod550_ss_aqua(:) = 0.
1641	aod550_dust_aqua(:) = 0.
1642	aod550_dustsco_aqua(:) = 0.
1643	aod670_aqua(:) = 0.
1644	aod670_tr2_aqua(:) = 0.
1645	aod670_ss_aqua(:) = 0.
1646	aod670_dust_aqua(:) = 0.
1647	aod670_dustsco_aqua(:) = 0.
1648	aod865_aqua(:) = 0.
1649	aod865_tr2_aqua(:) = 0.
1650	aod865_ss_aqua(:) = 0.
1651	aod865_dust_aqua(:) = 0.
1652	aod865_dustsco_aqua(:) = 0.
1653	!JE20150518>>
1654
1655	!Config Key = iflag_lscav
1656	!Config Desc = Large scale scavenging parametrization: 0=none,
1657	!1=old(Genthon92),
1658	! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
1659	!Config Def = 4
1660	!Config
1661	iflag_lscav_omp = 4
1662	call getin('iflag_lscav', iflag_lscav_omp)
1663	iflag_lscav = iflag_lscav_omp
1664	! initialiation for time computation
1665
1666	tia_spla = 0.
1667	tia_emis = 0.
1668	tia_depo = 0.
1669	tia_cltr = 0.
1670	tia_ther = 0.
1671	tia_sedi = 0.
1672	tia_gasp = 0.
1673	tia_wetap = 0.
1674	tia_cvltr = 0.
1675	tia_lscs = 0.
1676	tia_brop = 0.
1677	tia_outs = 0.
1678	tia_nophytracr = 0.
1679	clock_start_outphytracr = clock_end_outphytracr + 1
1680	!$OMP END MASTER
1681	!$OMP BARRIER
1682	ENDIF ! debutphy
1683
1684	lmt_dms(:) = 0.0
1685	aux_var2(:) = 0.0
1686	aux_var3(:, :) = 0.0
1687	source_tr(:, :) = 0.0
1688	flux_tr(:, :) = 0.0
1689	flux_sparam_bb(:) = 0.0
1690	flux_sparam_ff(:) = 0.0
1691	flux_sparam_ind(:) = 0.0
1692	flux_sparam_ddfine(:) = 0.0
1693	flux_sparam_ddcoa(:) = 0.0
1694	flux_sparam_ddsco(:) = 0.0
1695	flux_sparam_ssfine(:) = 0.0
1696	flux_sparam_sscoa(:) = 0.0
1697
1698	! initialiation for time computation
1699
1700	ti_spla = 0
1701	ti_emis = 0
1702	ti_depo = 0
1703	ti_cltr = 0
1704	ti_ther = 0
1705	ti_sedi = 0
1706	ti_gasp = 0
1707	ti_wetap = 0
1708	ti_cvltr = 0
1709	ti_lscs = 0
1710	ti_brop = 0
1711	ti_outs = 0
1712
1713	DO k = 1, klev
1714	DO i = 1, klon
1715	Mint(i, k) = 0.
1716	END DO
1717	END DO
1718
1719	DO itr = 1, nbtr
1720	DO k = 1, klev
1721	DO i = 1, klon
1722	d_tr_cv(i, k, itr) = 0.
1723	d_tr_trsp(i, k, itr) = 0.
1724	d_tr_sscav(i, k, itr) = 0.
1725	d_tr_sat(i, k, itr) = 0.
1726	d_tr_uscav(i, k, itr) = 0.
1727	d_tr(i, k, itr) = 0.
1728	d_tr_insc(i, k, itr) = 0.
1729	d_tr_bcscav(i, k, itr) = 0.
1730	d_tr_evapls(i, k, itr) = 0.
1731	d_tr_ls(i, k, itr) = 0.
1732	d_tr_cl(i, k, itr) = 0.
1733	d_tr_th(i, k, itr) = 0.
1734
1735	d_tr_cv_o(i, k, itr) = 0.
1736	d_tr_trsp_o(i, k, itr) = 0.
1737	d_tr_sscav_o(i, k, itr) = 0.
1738	d_tr_sat_o(i, k, itr) = 0.
1739	d_tr_uscav_o(i, k, itr) = 0.
1740
1741	qDi(i, k, itr) = 0.
1742	qPr(i, k, itr) = 0.
1743	qPa(i, k, itr) = 0.
1744	qMel(i, k, itr) = 0.
1745	qTrdi(i, k, itr) = 0.
1746	dtrcvMA(i, k, itr) = 0.
1747	zmfd1a(i, k, itr) = 0.
1748	zmfdam(i, k, itr) = 0.
1749	zmfphi2(i, k, itr) = 0.
1750	END DO
1751	END DO
1752	END DO
1753
1754	DO itr = 1, nbtr
1755	DO i = 1, klon
1756	qPrls(i, itr) = 0.0
1757	dtrconv(i, itr) = 0.0
1758	!JE20140507<<
1759	d_tr_dry(i, itr) = 0.0
1760	flux_tr_dry(i, itr) = 0.0
1761	!JE20140507>>
1762	ENDDO
1763	ENDDO
1764
1765	DO itr = 1, nbtr
1766	DO i = 1, klon
1767	his_dh(i, itr) = 0.0
1768	his_dhlsc(i, itr) = 0.0
1769	his_dhcon(i, itr) = 0.0
1770	his_dhbclsc(i, itr) = 0.0
1771	his_dhbccon(i, itr) = 0.0
1772	trm(i, itr) = 0.0
1773	his_th(i, itr) = 0.0
1774	his_dhkecv(i, itr) = 0.0
1775	his_ds(i, itr) = 0.0
1776	his_dhkelsc(i, itr) = 0.0
1777
1778	ENDDO
1779	ENDDO
1780	!JE:
1781	DO i = 1, klon
1782	his_g2pgas(i) = 0.0
1783	his_g2paer(i) = 0.0
1784	ENDDO
1785	! endJE
1786
1787	DO k = 1, klev
1788	DO i = 1, klon
1789	zrho(i, k) = pplay(i, k) / t_seri(i, k) / RD
1790	zdz(i, k) = (paprs(i, k) - paprs(i, k + 1)) / zrho(i, k) / RG
1791	zmasse(i, k) = (paprs(i, k) - paprs(i, k + 1)) / RG
1792	ENDDO
1793	ENDDO
1794
1795	DO i = 1, klon
1796	zalt(i, 1) = pphis(i) / RG
1797	ENDDO
1798	DO k = 1, klev - 1
1799	DO i = 1, klon
1800	zalt(i, k + 1) = zalt(i, k) + zdz(i, k)
1801	ENDDO
1802	ENDDO
1803
1804	IF (logitime) THEN
1805	CALL SYSTEM_CLOCK(COUNT = clock_end)
1806	dife = clock_end - clock_start
1807	ti_init = dife * MAX(0, SIGN(1, dife)) &
1808	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
1809	tia_init = tia_init + REAL(ti_init) / REAL(clock_rate)
1810	ENDIF
1811	IF (logitime) THEN
1812	CALL SYSTEM_CLOCK(COUNT = clock_start)
1813	ENDIF
1814
1815	IF (debutphy) then
1816
1817	! AS: initialisation des indices par point de grille physique iregion_*
1818	! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
1819	iregion_dust(:) = 1
1820	iregion_ind(:) = 1
1821	iregion_bb(:) = 1
1822	iregion_wstardust(:) = 1
1823
1824	!AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
1825	IF("ASSIM"=="YES") THEN
1826	c_FullName1 = 'regions_dustacc'
1827	!c_FullName1='regions_dust'
1828	call readregions_spl(iregion_dust, c_FullName1)
1829	c_FullName1 = 'regions_ind'
1830	call readregions_spl(iregion_ind, c_FullName1)
1831	c_FullName1 = 'regions_bb'
1832	call readregions_spl(iregion_bb, c_FullName1)
1833	c_FullName1 = 'regions_pwstarwake'
1834	call readregions_spl(iregion_wstardust, c_FullName1)
1835
1836	!$OMP MASTER
1837	IF (is_mpi_root .AND. is_omp_root) THEN
1838
1839	OPEN(25, FILE = 'dustregions_pyvar_je.data')
1840	OPEN(55, FILE = 'indregions_pyvar_je.data')
1841	OPEN(75, FILE = 'bbregions_pyvar_je.data')
1842	OPEN(95, FILE = 'wstardustregions_pyvar_je.data')
1843	OPEN(76, FILE = 'xlat.data')
1844	OPEN(77, FILE = 'xlon.data')
1845	ENDIF ! mpi root
1846	!$OMP END MASTER
1847	!$OMP BARRIER
1848
1849	CALL gather(iregion_dust, iauxklon_glo)
1850	!$OMP MASTER
1851	IF (is_mpi_root .AND. is_omp_root) THEN
1852	DO k = 1, klon_glo
1853	WRITE(25, '(i10)') iauxklon_glo(k)
1854	ENDDO
1855	ENDIF ! mpi root
1856	!$OMP END MASTER
1857	!$OMP BARRIER
1858	CALL gather(iregion_ind, iauxklon_glo)
1859	!$OMP MASTER
1860	IF (is_mpi_root .AND. is_omp_root) THEN
1861	DO k = 1, klon_glo
1862	WRITE(55, '(i10)') iauxklon_glo(k)
1863	ENDDO
1864	ENDIF ! mpi root
1865	!$OMP END MASTER
1866	!$OMP BARRIER
1867	CALL gather(iregion_bb, iauxklon_glo)
1868	!$OMP MASTER
1869	IF (is_mpi_root .AND. is_omp_root) THEN
1870	DO k = 1, klon_glo
1871	WRITE(75, '(i10)') iauxklon_glo(k)
1872	ENDDO
1873	ENDIF ! mpi root
1874	!$OMP END MASTER
1875	!$OMP BARRIER
1876	CALL gather(iregion_wstardust, iauxklon_glo)
1877	!$OMP MASTER
1878	IF (is_mpi_root .AND. is_omp_root) THEN
1879	DO k = 1, klon_glo
1880	WRITE(95, '(i10)') iauxklon_glo(k)
1881	ENDDO
1882	ENDIF ! mpi root
1883	!$OMP END MASTER
1884	!$OMP BARRIER
1885
1886	CALL gather(rlat, auxklon_glo)
1887	!$OMP MASTER
1888	IF (is_mpi_root .AND. is_omp_root) THEN
1889	DO k = 1, klon_glo
1890	WRITE(76, *) auxklon_glo(k)
1891	ENDDO
1892	ENDIF ! mpi root
1893	!$OMP END MASTER
1894	!$OMP BARRIER
1895	CALL gather(rlon, auxklon_glo)
1896	!$OMP MASTER
1897	IF (is_mpi_root .AND. is_omp_root) THEN
1898	DO k = 1, klon_glo
1899	WRITE(77, *) auxklon_glo(k)
1900	ENDDO
1901
1902	CLOSE(25)
1903	CLOSE(55)
1904	CLOSE(75)
1905	CLOSE(76)
1906	CLOSE(77)
1907	CLOSE(95)
1908
1909	ENDIF ! mpi root
1910	!$OMP END MASTER
1911	!$OMP BARRIER
1912
1913	ENDIF ! ASSIM
1914
1915	ENDIF ! debutphy
1916
1917	IF (logitime) THEN
1918	CALL SYSTEM_CLOCK(COUNT = clock_end)
1919	dife = clock_end - clock_start
1920	ti_inittype = dife * MAX(0, SIGN(1, dife)) &
1921	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
1922	tia_inittype = tia_inittype + REAL(ti_inittype) / REAL(clock_rate)
1923	ENDIF
1924
1925	IF (logitime) THEN
1926	CALL SYSTEM_CLOCK(COUNT = clock_start)
1927	ENDIF
1928
1929	!=======================================================================
1930	! SAVING SURFACE TYPE
1931	!=======================================================================
1932	IF (debutphy) THEN
1933	!$OMP MASTER
1934	IF (is_mpi_root .AND. is_omp_root) THEN
1935
1936	OPEN(35, FILE = 'surface_ocean.data')
1937	OPEN(45, FILE = 'surface_seaice.data')
1938	OPEN(65, FILE = 'surface_land.data')
1939	OPEN(85, FILE = 'surface_landice.data')
1940	ENDIF ! mpi root
1941	!$OMP END MASTER
1942	!$OMP BARRIER
1943	do i = 1, klon
1944	aux_var2(i) = pctsrf(i, is_oce)
1945	enddo
1946	call gather(aux_var2, auxklon_glo)
1947	!$OMP MASTER
1948	IF (is_mpi_root .AND. is_omp_root) THEN
1949	DO i = 1, klon_glo
1950	WRITE (35, 103) auxklon_glo(i)
1951	ENDDO
1952	ENDIF ! mpi root
1953	!$OMP END MASTER
1954	!$OMP BARRIER
1955
1956	do i = 1, klon
1957	aux_var2(i) = pctsrf(i, is_sic)
1958	enddo
1959	call gather(aux_var2, auxklon_glo)
1960	!$OMP MASTER
1961	IF (is_mpi_root .AND. is_omp_root) THEN
1962	DO i = 1, klon_glo
1963	WRITE (45, 103) auxklon_glo(i)
1964	ENDDO
1965	ENDIF ! mpi root
1966	!$OMP END MASTER
1967	!$OMP BARRIER
1968
1969	do i = 1, klon
1970	aux_var2(i) = pctsrf(i, is_ter)
1971	enddo
1972	call gather(aux_var2, auxklon_glo)
1973	!$OMP MASTER
1974	IF (is_mpi_root .AND. is_omp_root) THEN
1975	DO i = 1, klon_glo
1976	WRITE (65, 103) auxklon_glo(i)
1977	ENDDO
1978	ENDIF ! mpi root
1979	!$OMP END MASTER
1980	!$OMP BARRIER
1981
1982	do i = 1, klon
1983	aux_var2(i) = pctsrf(i, is_lic)
1984	enddo
1985	call gather(aux_var2, auxklon_glo)
1986	!$OMP MASTER
1987	IF (is_mpi_root .AND. is_omp_root) THEN
1988	DO i = 1, klon_glo
1989	WRITE (85, 103) auxklon_glo(i)
1990	ENDDO
1991
1992	! DO i = 1, klon
1993	! WRITE (35,103) pctsrf(i,is_oce)
1994	! WRITE (45,103) pctsrf(i,is_sic)
1995	! WRITE (65,103) pctsrf(i,is_ter)
1996	! WRITE (85,103) pctsrf(i,is_lic)
1997	! ENDDO
1998	CLOSE(35)
1999	CLOSE(45)
2000	CLOSE(65)
2001	CLOSE(85)
2002	103 FORMAT (f6.2)
2003	ENDIF ! mpi root
2004	!$OMP END MASTER
2005	!$OMP BARRIER
2006	ENDIF ! debutphy
2007
2008	! stop
2009
2010	!=======================================================================
2011
2012	DO itr = 1, nbtr
2013	DO j = 1, klev
2014	DO i = 1, klon
2015	tmp_var(i, j) = tr_seri(i, j, itr)
2016	ENDDO
2017	ENDDO
2018	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2019	DO j = 1, klev
2020	DO i = 1, klon
2021	tr_seri(i, j, itr) = tmp_var(i, j)
2022	ENDDO
2023	ENDDO
2024	ENDDO
2025	iscm3 = .true.
2026
2027	!=======================================================================
2028
2029	DO k = 1, klev
2030	DO i = 1, klon
2031	m_conc(i, k) = pplay(i, k) / t_seri(i, k) / RKBOL * 1.e-6
2032	ENDDO
2033	ENDDO
2034
2035	IF (lminmax) THEN
2036	DO itr = 1, nbtr
2037	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_avt_coarem')
2038	ENDDO
2039	DO itr = 1, nbtr
2040	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'avt coarem')
2041	ENDDO
2042	CALL minmaxsource(source_tr, qmin, qmax, 'src: avt coarem')
2043	ENDIF
2044
2045	IF (logitime) THEN
2046	CALL SYSTEM_CLOCK(COUNT = clock_end)
2047	dife = clock_end - clock_start
2048	ti_inittwrite = dife * MAX(0, SIGN(1, dife)) &
2049	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2050	tia_inittwrite = tia_inittwrite + REAL(ti_inittwrite) / REAL(clock_rate)
2051	ENDIF
2052
2053
2054	!=======================================================================
2055	! EMISSIONS OF COARSE AEROSOLS
2056	!=======================================================================
2057
2058	IF (logitime) THEN
2059	CALL SYSTEM_CLOCK(COUNT = clock_start)
2060	ENDIF
2061
2062	print *, 'Number of tracers = ', nbtr
2063
2064	print *, 'AT BEGINNING OF PHYTRACR_SPL'
2065	! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
2066	! . MAXVAL(tr_seri(:,:,3))
2067	#ifdef IOPHYS_DUST
2068	do itr=1,nbtr
2069	write(str2,'(i2.2)') itr
2070	call iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
2071	call iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
2072	enddo
2073	do itr=1,nbtr
2074	write(str2,'(i2.2)') itr
2075	call iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2076	enddo
2077	#endif
2078
2079
2080	CALL coarsemission(pctsrf, pdtphys, t_seri, &
2081	pmflxr, pmflxs, prfl, psfl, &
2082	rlat, rlon, debutphy, &
2083	zu10m, zv10m, wstar, ale_bl, ale_wake, &
2084	scale_param_ssacc, scale_param_sscoa, &
2085	scale_param_dustacc, scale_param_dustcoa, &
2086	scale_param_dustsco, &
2087	nbreg_dust, &
2088	iregion_dust, dust_ec, &
2089	param_wstarBLperregion, param_wstarWAKEperregion, &
2090	nbreg_wstardust, &
2091	iregion_wstardust, &
2092	lmt_sea_salt, qmin, qmax, &
2093	flux_sparam_ddfine, flux_sparam_ddcoa, &
2094	flux_sparam_ddsco, &
2095	flux_sparam_ssfine, flux_sparam_sscoa, &
2096	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2097	ok_chimeredust, &
2098	source_tr, flux_tr)
2099
2100	#ifdef IOPHYS_DUST
2101	do itr=1,nbtr
2102	write(str2,'(i2.2)') itr
2103	call iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
2104	call iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,itr))
2105	enddo
2106	#endif
2107
2108	IF (lminmax) THEN
2109	DO itr = 1, nbtr
2110	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_coarem')
2111	ENDDO
2112	DO itr = 1, nbtr
2113	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after coarem')
2114	ENDDO
2115	CALL minmaxsource(source_tr, qmin, qmax, 'src: after coarem')
2116	ENDIF
2117
2118
2119
2120	!======================================================================
2121	! EMISSIONS OF AEROSOL PRECURSORS
2122	!======================================================================
2123
2124	#ifdef IOPHYS_DUST
2125	print *,'INPUT TO PRECUREMISSION'
2126	call iophys_ecrit('ftsol',4,'ftsol','',ftsol)
2127	call iophys_ecrit('u10m_ec',1,'u10m_ec','',u10m_ec)
2128	call iophys_ecrit('v10m_ec',1,'v10m_ec','',v10m_ec)
2129	call iophys_ecrit('pctsrf',4,'pctsrf','',pctsrf)
2130	call iophys_ecrit('u_seri',klev,'u_seri','',u_seri)
2131	call iophys_ecrit('v_seri',klev,'v_seri','',v_seri)
2132	call iophys_ecrit('paprs',klev,'paprs','',paprs)
2133	call iophys_ecrit('pplay',klev,'pplay','',pplay)
2134	call iophys_ecrit('cdragh',1,'cdragh','',cdragh)
2135	call iophys_ecrit('cdragm',1,'cdragm','',cdragm)
2136	call iophys_ecrit('t_seri',klev,'t_seri','',t_seri)
2137	call iophys_ecrit('q_seri',klev,'q_seri','',q_seri)
2138	call iophys_ecrit('tsol',1,'tsol','',tsol)
2139	print*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau
2140	print*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys
2141	print*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind
2142	print*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb
2143	print*,'id_prec,id_fine',id_prec,id_fine
2144	call iophys_ecrit('zdz',klev,'zdz','',zdz)
2145	call iophys_ecrit('zalt',klev,'zalt','',zalt)
2146	call iophys_ecrit('lmt_so2ff_l',1,'lmt_so2ff_l','',lmt_so2ff_l)
2147	call iophys_ecrit('lmt_so2ff_h',1,'lmt_so2ff_h','',lmt_so2ff_h)
2148	call iophys_ecrit('lmt_so2nff',1,'lmt_so2nff','',lmt_so2nff)
2149	call iophys_ecrit('lmt_so2ba',1,'lmt_so2ba','',lmt_so2ba)
2150	call iophys_ecrit('lmt_so2bb_l',1,'lmt_so2bb_l','',lmt_so2bb_l)
2151	call iophys_ecrit('lmt_so2bb_h',1,'lmt_so2bb_h','',lmt_so2bb_h)
2152	call iophys_ecrit('lmt_so2volc_cont',1,'lmt_so2volc_cont','',lmt_so2volc_cont)
2153	call iophys_ecrit('lmt_altvolc_cont',1,'lmt_altvolc_cont','',lmt_altvolc_cont)
2154	call iophys_ecrit('lmt_so2volc_expl',1,'lmt_so2volc_expl','',lmt_so2volc_expl)
2155	call iophys_ecrit('lmt_altvolc_expl',1,'lmt_altvolc_expl','',lmt_altvolc_expl)
2156	call iophys_ecrit('lmt_dmsbio',1,'lmt_dmsbio','',lmt_dmsbio)
2157	call iophys_ecrit('lmt_h2sbio',1,'lmt_h2sbio','',lmt_h2sbio)
2158	call iophys_ecrit('lmt_dmsconc',1,'lmt_dmsconc','',lmt_dmsconc)
2159	call iophys_ecrit('lmt_dms',1,'lmt_dms','',lmt_dms)
2160	call iophys_ecrit('flux_sparam_ind',1,'flux_sparam_ind','',flux_sparam_ind)
2161	call iophys_ecrit('flux_sparam_bb',1,'flux_sparam_bb','',flux_sparam_bb)
2162	#endif
2163
2164
2165
2166	print*, 'ON PASSE DANS precuremission'
2167	CALL precuremission(ftsol, u10m_ec, v10m_ec, pctsrf, &
2168	u_seri, v_seri, paprs, pplay, cdragh, cdragm, &
2169	t_seri, q_seri, tsol, fracso2emis, frach2sofso2, &
2170	bateau, zdz, zalt, kminbc, kmaxbc, pdtphys, &
2171	scale_param_bb, scale_param_ind, &
2172	iregion_ind, iregion_bb, &
2173	nbreg_ind, nbreg_bb, &
2174	lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, lmt_so2ba, &
2175	lmt_so2bb_l, lmt_so2bb_h, &
2176	lmt_so2volc_cont, lmt_altvolc_cont, &
2177	lmt_so2volc_expl, lmt_altvolc_expl, &
2178	lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, lmt_dms, &
2179	id_prec, id_fine, &
2180	flux_sparam_ind, flux_sparam_bb, &
2181	source_tr, flux_tr, tr_seri)
2182
2183	IF (lminmax) THEN
2184	DO itr = 1, nbtr
2185	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after precur')
2186	ENDDO
2187	DO itr = 1, nbtr
2188	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after precur')
2189	ENDDO
2190	CALL minmaxsource(source_tr, qmin, qmax, 'src: after precur')
2191	ENDIF
2192
2193	!=======================================================================
2194	! EMISSIONS OF FINE AEROSOLS
2195	!=======================================================================
2196	#ifdef IOPHYS_DUST
2197
2198	do itr=1,nbtr
2199	write(str2,'(i2.2)') itr
2200	call iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
2201	call iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,itr))
2202	enddo
2203	#endif
2204
2205	CALL finemission(zdz, pdtphys, zalt, kminbc, kmaxbc, &
2206	scale_param_bb, scale_param_ff, &
2207	iregion_ind, iregion_bb, &
2208	nbreg_ind, nbreg_bb, &
2209	lmt_bcff, lmt_bcnff, lmt_bcbb_l, lmt_bcbb_h, &
2210	lmt_bcba, lmt_omff, lmt_omnff, &
2211	lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, &
2212	id_fine, &
2213	flux_sparam_bb, flux_sparam_ff, &
2214	source_tr, flux_tr, tr_seri)
2215
2216	IF (lminmax) THEN
2217	DO itr = 1, nbtr
2218	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_fineem')
2219	ENDDO
2220	DO itr = 1, nbtr
2221	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after fineem')
2222	ENDDO
2223	IF (lcheckmass) THEN
2224	DO itr = 1, nbtr
2225	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2226	pplay, t_seri, iscm3, 'after fineem')
2227	ENDDO
2228	ENDIF
2229	CALL minmaxsource(source_tr, qmin, qmax, 'src: after fineem')
2230	ENDIF
2231
2232	IF (logitime) THEN
2233	CALL SYSTEM_CLOCK(COUNT = clock_end)
2234	dife = clock_end - clock_start
2235	ti_emis = dife * MAX(0, SIGN(1, dife)) &
2236	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2237	tia_emis = tia_emis + REAL(ti_emis) / REAL(clock_rate)
2238	ENDIF
2239
2240
2241	#ifdef IOPHYS_DUST
2242	do itr=1,nbtr
2243	write(str2,'(i2.2)') itr
2244	call iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
2245	call iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,itr))
2246	enddo
2247	#endif
2248
2249
2250	!=======================================================================
2251	! DRY DEPOSITION AND BOUNDARY LAYER MIXING
2252	!=======================================================================
2253
2254	! DO itr=1,nbtr
2255	! CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,
2256	! . pplay,t_seri,iscm3,'')
2257	! ENDDO
2258
2259	!======================================================================
2260	! -- Dry deposition --
2261	!======================================================================
2262	IF (logitime) THEN
2263	CALL SYSTEM_CLOCK(COUNT = clock_start)
2264	ENDIF
2265
2266	DO itr = 1, nbtr
2267	DO j = 1, klev
2268	DO i = 1, klon
2269	tmp_var(i, j) = tr_seri(i, j, itr)
2270	ENDDO
2271	ENDDO
2272	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2273	DO j = 1, klev
2274	DO i = 1, klon
2275	tr_seri(i, j, itr) = tmp_var(i, j)
2276	ENDDO
2277	ENDDO
2278	ENDDO
2279	iscm3 = .false.
2280	!----------------------------
2281	IF (lminmax) THEN
2282	DO itr = 1, nbtr
2283	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_depo')
2284	ENDDO
2285	DO itr = 1, nbtr
2286	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before depo')
2287	ENDDO
2288	IF (lcheckmass) THEN
2289	DO itr = 1, nbtr
2290	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2291	pplay, t_seri, iscm3, 'before depo')
2292	ENDDO
2293	ENDIF
2294	CALL minmaxsource(source_tr, qmin, qmax, 'src: before depo')
2295	ENDIF
2296
2297	#ifdef IOPHYS_DUST
2298	do itr=1,nbtr
2299	write(str2,'(i2.2)') itr
2300	call iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2301	enddo
2302	#endif
2303
2304	CALL deposition(vdep_oce, vdep_sic, vdep_ter, vdep_lic, pctsrf, &
2305	zrho, zdz, pdtphys, RHcl, masse, t_seri, pplay, paprs, &
2306	lminmax, qmin, qmax, &
2307	his_ds, source_tr, tr_seri)
2308
2309	IF (lminmax) THEN
2310	DO itr = 1, nbtr
2311	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_depo')
2312	ENDDO
2313	DO itr = 1, nbtr
2314	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after depo')
2315	ENDDO
2316	IF (lcheckmass) THEN
2317	DO itr = 1, nbtr
2318	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2319	pplay, t_seri, iscm3, 'after depo')
2320	ENDDO
2321	ENDIF
2322	CALL minmaxsource(source_tr, qmin, qmax, 'src: after depo')
2323	ENDIF
2324
2325	IF (logitime) THEN
2326	CALL SYSTEM_CLOCK(COUNT = clock_end)
2327	dife = clock_end - clock_start
2328	ti_depo = dife * MAX(0, SIGN(1, dife)) &
2329	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2330	tia_depo = tia_depo + REAL(ti_depo) / REAL(clock_rate)
2331	ENDIF
2332
2333	!======================================================================
2334	! -- Boundary layer mixing --
2335	!======================================================================
2336
2337	#ifdef IOPHYS_DUST
2338	do itr=1,nbtr
2339	write(str2,'(i2.2)') itr
2340	call iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2341	enddo
2342	#endif
2343
2344
2345
2346	IF (logitime) THEN
2347	CALL SYSTEM_CLOCK(COUNT = clock_start)
2348	ENDIF
2349
2350	DO k = 1, klev
2351	DO i = 1, klon
2352	delp(i, k) = paprs(i, k) - paprs(i, k + 1)
2353	END DO
2354	END DO
2355
2356	DO itr = 1, nbtr
2357	DO j = 1, klev
2358	DO i = 1, klon
2359	tmp_var(i, j) = tr_seri(i, j, itr)
2360	aux_var2(i) = source_tr(i, itr)
2361	ENDDO
2362	ENDDO
2363	IF (iflag_conv==2) THEN
2364	! Tiedke
2365	CALL cltrac_spl(pdtphys, coefh, yu1, yv1, t_seri, tmp_var, &
2366	aux_var2, paprs, pplay, aux_var3)
2367
2368	ELSE IF (iflag_conv>=3) THEN
2369	!KE
2370	CALL cltrac(pdtphys, coefh, t_seri, tmp_var, aux_var2, paprs, pplay, &
2371	delp, aux_var3, d_tr_dry, flux_tr_dry(:, itr))
2372	ENDIF
2373
2374	DO i = 1, klon
2375	DO j = 1, klev
2376	tr_seri(i, j, itr) = tmp_var(i, j)
2377	d_tr(i, j, itr) = aux_var3(i, j)
2378	d_tr_cl(i, j, itr) = d_tr(i, j, itr)
2379	ENDDO
2380	ENDDO
2381	DO k = 1, klev
2382	DO i = 1, klon
2383	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr(i, k, itr)
2384	ENDDO
2385	ENDDO
2386	print *, ' AFTER Cltrac'
2387	IF (lminmax) THEN
2388	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after cltrac')
2389	ENDIF
2390	ENDDO !--end itr loop
2391
2392	IF (logitime) THEN
2393	CALL SYSTEM_CLOCK(COUNT = clock_end)
2394	dife = clock_end - clock_start
2395	ti_cltr = dife * MAX(0, SIGN(1, dife)) &
2396	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2397	tia_cltr = tia_cltr + REAL(ti_cltr) / REAL(clock_rate)
2398	ENDIF
2399
2400
2401
2402	!======================================================================
2403	! -- Calcul de l'effet des thermiques for KE--
2404	!======================================================================
2405
2406	#ifdef IOPHYS_DUST
2407	print*,'iflag_conv=',iflag_conv
2408	call iophys_ecrit('coefh',klev,'coefh','',coefh)
2409	call iophys_ecrit('yu1',1,'yu1','',yu1)
2410	call iophys_ecrit('yv1',1,'yv1','',yv1)
2411	call iophys_ecrit('delp',klev,'delp','',delp)
2412	do itr=1,nbtr
2413	write(str2,'(i2.2)') itr
2414	call iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2415	enddo
2416	#endif
2417
2418
2419
2420	IF (iflag_conv>=3) THEN
2421
2422	IF (logitime) THEN
2423	CALL SYSTEM_CLOCK(COUNT = clock_start)
2424	ENDIF
2425
2426	IF (lminmax) THEN
2427	DO itr = 1, nbtr
2428	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before therm')
2429	ENDDO
2430	DO itr = 1, nbtr
2431	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before therm')
2432	ENDDO
2433	IF (lcheckmass) THEN
2434	DO itr = 1, nbtr
2435	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2436	pplay, t_seri, iscm3, 'before therm')
2437	ENDDO
2438	ENDIF
2439	CALL minmaxsource(source_tr, qmin, qmax, 'before therm')
2440	ENDIF
2441
2442	DO itr = 1, nbtr
2443	DO k = 1, klev
2444	DO i = 1, klon
2445	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2446	d_tr_th(i, k, itr) = 0.
2447	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr), 0.)
2448	!JE: precursor >>1e10 tr_seri(i,k,itr)=MIN(tr_seri(i,k,itr),1.e10)
2449	END DO
2450	END DO
2451	END DO
2452
2453	!JE new implicit scheme 20140323
2454	DO itr = 1, nbtr
2455	CALL thermcell_dq(klon, klev, 1, pdtphys, fm_therm, entr_therm, &
2456	zmasse, tr_seri(1:klon, 1:klev, itr), &
2457	d_tr(1:klon, 1:klev, itr), ztra_th, 0)
2458
2459	DO k = 1, klev
2460	DO i = 1, klon
2461	d_tr(i, k, itr) = pdtphys * d_tr(i, k, itr)
2462	d_tr_th(i, k, itr) = d_tr_th(i, k, itr) + d_tr(i, k, itr)
2463	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr) + d_tr(i, k, itr), 0.)
2464	END DO
2465	END DO
2466
2467	ENDDO
2468
2469	! old scheme explicit
2470	! nsplit=10
2471	! DO itr=1,nbtr
2472	! DO isplit=1,nsplit
2473	! CALL dqthermcell(klon,klev,pdtphys/nsplit,
2474	! . fm_therm,entr_therm,zmasse,
2475	! . tr_seri(1:klon,1:klev,itr),
2476	! . d_tr(1:klon,1:klev,itr),ztra_th)
2477	! DO k=1,klev
2478	! DO i=1,klon
2479	! d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)/nsplit
2480	! d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
2481	! tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
2482	! END DO
2483	! END DO
2484	! END DO ! nsplit1
2485	! END DO ! it
2486	!JE end modif 20140323
2487
2488	DO itr = 1, nbtr
2489	DO k = 1, klev
2490	DO i = 1, klon
2491	tmp_var(i, k) = tr_seri(i, k, itr) - tmp_var3(i, k, itr)
2492	ENDDO
2493	ENDDO
2494	IF (lminmax) THEN
2495	IF (lcheckmass) THEN
2496	CALL checkmass(tmp_var(:, :), RNAVO, masse(itr), zdz, &
2497	pplay, t_seri, iscm3, 'dtr therm ')
2498	ENDIF
2499	ENDIF
2500	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2501
2502	DO k = 1, klev
2503	DO i = 1, klon
2504	his_th(i, itr) = his_th(i, itr) + &
2505	(tmp_var(i, k)) / RNAVO * &
2506	masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2507	END DO !klon
2508	END DO !klev
2509
2510	END DO !it
2511	IF (lminmax) THEN
2512	DO itr = 1, nbtr
2513	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after therm')
2514	ENDDO
2515	DO itr = 1, nbtr
2516	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after therm')
2517	ENDDO
2518	IF (lcheckmass) THEN
2519	DO itr = 1, nbtr
2520	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2521	pplay, t_seri, iscm3, 'after therm')
2522	ENDDO
2523	ENDIF
2524	CALL minmaxsource(source_tr, qmin, qmax, 'after therm')
2525	ENDIF
2526
2527	IF (logitime) THEN
2528	CALL SYSTEM_CLOCK(COUNT = clock_end)
2529	dife = clock_end - clock_start
2530	ti_ther = dife * MAX(0, SIGN(1, dife)) &
2531	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2532	tia_ther = tia_ther + REAL(ti_ther) / REAL(clock_rate)
2533	ENDIF
2534
2535	ENDIF ! iflag_conv KE
2536	!------------------------------------
2537	! Sedimentation
2538	!-----------------------------------
2539	IF (logitime) THEN
2540	CALL SYSTEM_CLOCK(COUNT = clock_start)
2541	ENDIF
2542
2543	DO itr = 1, nbtr
2544	DO j = 1, klev
2545	DO i = 1, klon
2546	tmp_var(i, j) = tr_seri(i, j, itr)
2547	ENDDO
2548	ENDDO
2549	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2550	DO j = 1, klev
2551	DO i = 1, klon
2552	tr_seri(i, j, itr) = tmp_var(i, j)
2553	ENDDO
2554	ENDDO
2555	ENDDO !--end itr loop
2556	iscm3 = .true.
2557	!--------------------------------------
2558	print *, ' BEFORE Sediment'
2559
2560	IF (lminmax) THEN
2561	DO itr = 1, nbtr
2562	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_sedi')
2563	ENDDO
2564	DO itr = 1, nbtr
2565	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before sedi')
2566	ENDDO
2567	IF (lcheckmass) THEN
2568	DO itr = 1, nbtr
2569	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2570	pplay, t_seri, iscm3, 'before sedi')
2571	ENDDO
2572	ENDIF
2573	CALL minmaxsource(source_tr, qmin, qmax, 'src: before sedi')
2574	ENDIF
2575
2576	print *, 'SPLA VERSION OF SEDIMENTATION IS USED'
2577	CALL sediment_mod(t_seri, pplay, zrho, paprs, pdtphys, RHcl, &
2578	id_coss, id_codu, id_scdu, &
2579	ok_chimeredust, &
2580	sed_ss, sed_dust, sed_dustsco, &
2581	sed_ss3D, sed_dust3D, sed_dustsco3D, tr_seri)
2582	CALL cm3_to_kg(pplay, t_seri, sed_ss3D)
2583	CALL cm3_to_kg(pplay, t_seri, sed_dust3D)
2584	CALL cm3_to_kg(pplay, t_seri, sed_dustsco3D)
2585
2586	IF (lminmax) THEN
2587	DO itr = 1, nbtr
2588	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_sedi')
2589	ENDDO
2590	DO itr = 1, nbtr
2591	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after sedi')
2592	ENDDO
2593	IF (lcheckmass) THEN
2594	DO itr = 1, nbtr
2595	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2596	pplay, t_seri, iscm3, 'after sedi')
2597	ENDDO
2598	ENDIF
2599	CALL minmaxsource(source_tr, qmin, qmax, 'src: after sedi')
2600	ENDIF
2601
2602	!=======================================================================
2603	#ifdef IOPHYS_DUST
2604	do itr=1,nbtr
2605	write(str2,'(i2.2)') itr
2606	call iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2607	enddo
2608	#endif
2609
2610	IF (logitime) THEN
2611	CALL SYSTEM_CLOCK(COUNT = clock_end)
2612	dife = clock_end - clock_start
2613	ti_sedi = dife * MAX(0, SIGN(1, dife)) &
2614	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2615	tia_sedi = tia_sedi + REAL(ti_sedi) / REAL(clock_rate)
2616	ENDIF
2617
2618	DO itr = 1, nbtr
2619	DO j = 1, klev
2620	DO i = 1, klon
2621	tmp_var(i, j) = tr_seri(i, j, itr)
2622	ENDDO
2623	ENDDO
2624	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2625	DO j = 1, klev
2626	DO i = 1, klon
2627	tr_seri(i, j, itr) = tmp_var(i, j)
2628	ENDDO
2629	ENDDO
2630	ENDDO
2631	iscm3 = .false.
2632
2633
2634	!======================================================================
2635	! GAS TO PARTICLE CONVERSION
2636	!======================================================================
2637
2638	IF (logitime) THEN
2639	CALL SYSTEM_CLOCK(COUNT = clock_start)
2640	ENDIF
2641
2642	IF (lminmax) THEN
2643	DO itr = 1, nbtr
2644	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_beforegastopar')
2645	ENDDO
2646	DO itr = 1, nbtr
2647	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before gastopar')
2648	ENDDO
2649	IF (lcheckmass) THEN
2650	DO itr = 1, nbtr
2651	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2652	pplay, t_seri, iscm3, 'before gastopar')
2653	ENDDO
2654	ENDIF
2655	CALL minmaxsource(source_tr, qmin, qmax, 'src: before gastopar')
2656	ENDIF
2657
2658	CALL gastoparticle(pdtphys, zdz, zrho, rlat, &
2659	pplay, t_seri, id_prec, id_fine, &
2660	tr_seri, his_g2pgas, his_g2paer)
2661
2662	IF (lminmax) THEN
2663	DO itr = 1, nbtr
2664	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_gastopar')
2665	ENDDO
2666	DO itr = 1, nbtr
2667	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after gastopar')
2668	ENDDO
2669	IF (lcheckmass) THEN
2670	DO itr = 1, nbtr
2671	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2672	pplay, t_seri, iscm3, 'after gastopar')
2673	ENDDO
2674	ENDIF
2675	CALL minmaxsource(source_tr, qmin, qmax, 'src: after gastopar')
2676	ENDIF
2677
2678	IF (logitime) THEN
2679	CALL SYSTEM_CLOCK(COUNT = clock_end)
2680	dife = clock_end - clock_start
2681	ti_gasp = dife * MAX(0, SIGN(1, dife)) &
2682	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2683	tia_gasp = tia_gasp + REAL(ti_gasp) / REAL(clock_rate)
2684	ENDIF
2685
2686	!======================================================================
2687	! EFFECT OF PRECIPITATION: iflag_conv=2
2688	!======================================================================
2689
2690	#ifdef IOPHYS_DUST
2691	do itr=1,nbtr
2692	write(str2,'(i2.2)') itr
2693	call iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2694	enddo
2695	#endif
2696
2697
2698	IF (iflag_conv==2) THEN
2699
2700	IF (logitime) THEN
2701	CALL SYSTEM_CLOCK(COUNT = clock_start)
2702	ENDIF
2703
2704	DO itr = 1, nbtr
2705	DO j = 1, klev
2706	DO i = 1, klon
2707	tmp_var(i, j) = tr_seri(i, j, itr)
2708	ENDDO
2709	ENDDO
2710	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2711	DO j = 1, klev
2712	DO i = 1, klon
2713	tr_seri(i, j, itr) = tmp_var(i, j)
2714	ENDDO
2715	ENDDO
2716	ENDDO
2717	iscm3 = .true.
2718	!------------------------------
2719
2720	print *, 'iflag_conv bef lessiv', iflag_conv
2721	IF (lessivage) THEN
2722
2723	print *, ' BEFORE Incloud'
2724
2725	IF (lminmax) THEN
2726	DO itr = 1, nbtr
2727	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_incloud')
2728	ENDDO
2729	DO itr = 1, nbtr
2730	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before incloud')
2731	ENDDO
2732	IF (lcheckmass) THEN
2733	DO itr = 1, nbtr
2734	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2735	pplay, t_seri, iscm3, 'before incloud')
2736	ENDDO
2737	ENDIF
2738	CALL minmaxsource(source_tr, qmin, qmax, 'src: before incloud')
2739	ENDIF
2740
2741
2742	! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
2743	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2744
2745	! . his_dhlsc,his_dhcon,tr_seri)
2746	print *, 'iflag_conv bef incloud', iflag_conv
2747
2748	IF (iflag_conv==2) THEN
2749	! Tiedke
2750	CALL incloud_scav(.false., qmin, qmax, masse, henry, kk, prfl, &
2751	psfl, pmflxr, pmflxs, zrho, zdz, t_seri, pdtphys, &
2752	his_dhlsc, his_dhcon, tr_seri)
2753
2754	!---------- to use this option please comment lsc_scav at the end
2755	! ELSE IF (iflag_conv.GE.3) THEN
2756
2757	! CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl,
2758	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2759	! . his_dhlsc,his_dhcon,tr_seri)
2760	!--------------------------------------------------------------
2761
2762	ENDIF
2763
2764	print *, ' BEFORE blcloud (after incloud)'
2765	IF (lminmax) THEN
2766	DO itr = 1, nbtr
2767	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_blcloud')
2768	ENDDO
2769	DO itr = 1, nbtr
2770	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before blcloud')
2771	ENDDO
2772	IF (lcheckmass) THEN
2773	DO itr = 1, nbtr
2774	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2775	pplay, t_seri, iscm3, 'before blcloud')
2776	ENDDO
2777	ENDIF
2778	CALL minmaxsource(source_tr, qmin, qmax, 'src: before blcloud')
2779	ENDIF
2780
2781	! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
2782	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2783	! . his_dhbclsc,his_dhbccon,tr_seri)
2784
2785	IF (iflag_conv==2) THEN
2786	! Tiedke
2787
2788	CALL blcloud_scav(.false., qmin, qmax, pdtphys, prfl, psfl, &
2789	pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
2790	his_dhbclsc, his_dhbccon, tr_seri)
2791
2792	!---------- to use this option please comment lsc_scav at the end
2793	! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
2794
2795
2796	! ELSE IF (iflag_conv.GE.3) THEN
2797
2798	! CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl,
2799	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2800	! . his_dhbclsc,his_dhbccon,tr_seri)
2801
2802	!----------------------------------------------------------------------
2803	ENDIF
2804
2805	print *, ' AFTER blcloud '
2806
2807	IF (lminmax) THEN
2808	DO itr = 1, nbtr
2809	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_blcloud')
2810	ENDDO
2811	DO itr = 1, nbtr
2812	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after blcloud')
2813	ENDDO
2814	IF (lcheckmass) THEN
2815	DO itr = 1, nbtr
2816	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2817	pplay, t_seri, iscm3, 'after blcloud')
2818	ENDDO
2819	ENDIF
2820	CALL minmaxsource(source_tr, qmin, qmax, 'src: after blcloud')
2821	ENDIF
2822
2823	ENDIF !--lessivage
2824
2825	DO itr = 1, nbtr
2826	DO j = 1, klev
2827	DO i = 1, klon
2828	tmp_var(i, j) = tr_seri(i, j, itr)
2829	ENDDO
2830	ENDDO
2831	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2832	DO j = 1, klev
2833	DO i = 1, klon
2834	tr_seri(i, j, itr) = tmp_var(i, j)
2835	ENDDO
2836	ENDDO
2837	ENDDO
2838	iscm3 = .false.
2839
2840	IF (logitime) THEN
2841	CALL SYSTEM_CLOCK(COUNT = clock_end)
2842	dife = clock_end - clock_start
2843	ti_wetap = dife * MAX(0, SIGN(1, dife)) &
2844	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2845	tia_wetap = tia_wetap + REAL(ti_wetap) / REAL(clock_rate)
2846	ENDIF
2847
2848	ENDIF ! iflag_conv=2
2849
2850
2851	!======================================================================
2852	! EFFECT OF CONVECTION
2853	!======================================================================
2854
2855	#ifdef IOPHYS_DUST
2856	do itr=1,nbtr
2857	write(str2,'(i2.2)') itr
2858	call iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2859	enddo
2860	#endif
2861
2862
2863	IF (logitime) THEN
2864	CALL SYSTEM_CLOCK(COUNT = clock_start)
2865	ENDIF
2866
2867	IF (convection) THEN
2868
2869	print *, ' BEFORE trconvect'
2870
2871	IF (lminmax) THEN
2872	DO itr = 1, nbtr
2873	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_trconve')
2874	ENDDO
2875	DO itr = 1, nbtr
2876	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before trconve')
2877	ENDDO
2878	IF (lcheckmass) THEN
2879	DO itr = 1, nbtr
2880	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2881	pplay, t_seri, iscm3, 'before trconve')
2882	ENDDO
2883	ENDIF
2884	CALL minmaxsource(source_tr, qmin, qmax, 'src: before trconve')
2885	ENDIF
2886
2887
2888	! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
2889	! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
2890	! . dtrconv,tr_seri)
2891	! -------------------------------------------------------------
2892	IF (iflag_conv==2) THEN
2893	! Tiedke
2894	CALL trconvect(pplay, t_seri, pdtphys, pmfu, pmfd, pen_u, pde_u, &
2895	pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .false., masse, &
2896	dtrconv, tr_seri)
2897	DO itr = 1, nbtr
2898	d_tr_cv(:, :, itr) = 0.
2899	ENDDO
2900
2901	ELSE IF (iflag_conv>=3) THEN
2902	! KE
2903	print *, 'JE: KE in phytracr_spl'
2904	DO itr = 1, nbtr
2905	DO k = 1, klev
2906	DO i = 1, klon
2907	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2908	END DO
2909	END DO
2910	ENDDO
2911
2912	DO itr = 1, nbtr
2913	! routine for aerosols . otherwise, check cvltrorig
2914	print *, 'Check sum before cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2915	! IF (.FALSE.) THEN
2916	CALL cvltr_spl(pdtphys, da, phi, phi2, d1a, dam, mp, ep, &
2917	sigd, sij, wght_cvfd, clw, elij, epmlmMm, eplaMm, &
2918	pmflxr, pmflxs, evapls, t_seri, wdtrainA, wdtrainM, &
2919	! paprs,itr,tr_seri,upwd,dnwd,itop_con,ibas_con, &
2920	paprs, itr, tmp_var3, upwd, dnwd, itop_con, ibas_con, &
2921	henry, kk, zrho, ccntrAA_spla, ccntrENV_spla, coefcoli_spla, &
2922	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2923	d_tr_cv, d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, qDi, qPr, &
2924	qPa, qMel, qTrdi, dtrcvMA, Mint, &
2925	zmfd1a, zmfphi2, zmfdam)
2926	! ENDIF
2927
2928	! IF (.FALSE.) THEN
2929	! CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
2930	! . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
2931	! . pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,
2932	! . paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,
2933	! . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
2934	! . qPa,qMel,qTrdi,dtrcvMA,Mint,
2935	! . zmfd1a,zmfphi2,zmfdam)
2936	!! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
2937	! ENDIF
2938
2939
2940
2941	!!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
2942	!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
2943	!!! . upwd,dnwd,d_tr_cv)
2944	! print *,'justbefore cvltrnoscav it= ',it
2945	! CALL checknanqfi(da(:,:),1.,-1.,' da')
2946	! CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ')
2947	! CALL checknanqfi(mp(:,:),1.,-1.,'mp ')
2948	! CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ')
2949	! CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ')
2950	! CALL checknanqfi(tmp_var3(:,:,itr),1.,-1.,'tmp_var3 ')
2951	! CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ')
2952	! CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ')
2953	! CALL checknanqfi(d_tr_cv(:,:,itr),1.,-1.,'d_tr_cv ')
2954	! IF (.TRUE.) THEN
2955	! CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
2956	! . pplay,tmp_var3,upwd,dnwd,d_tr_cv)
2957	! ENDIF
2958	DO k = 1, klev
2959	DO i = 1, klon
2960	! tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr_cv(i,k,itr)
2961	tr_seri(i, k, itr) = (tmp_var3(i, k, itr) + d_tr_cv(i, k, itr))
2962	tmp_var(i, k) = d_tr_cv(i, k, itr)
2963
2964	END DO
2965	END DO
2966
2967	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2968
2969	DO k = 1, klev
2970	DO i = 1, klon
2971	dtrconv(i, itr) = 0.0
2972	his_dhkecv(i, itr) = his_dhkecv(i, itr) - tmp_var(i, k) &
2973	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2974	END DO
2975	END DO
2976
2977	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2978	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2979
2980	DO k = 1, klev
2981	DO i = 1, klon
2982	dtrconv(i, itr) = 0.0
2983	his_ds(i, itr) = his_ds(i, itr) - tmp_var(i, k) &
2984	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2985	END DO
2986	END DO
2987	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2988	IF (lminmax) THEN
2989
2990	print *, 'Check sum after cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2991	CALL minmaxqfi2(d_tr_cv(:, :, itr), qmin, qmax, 'd_tr_cv:')
2992	CALL minmaxqfi2(d_tr_trsp(:, :, itr), qmin, qmax, 'd_tr_trsp:')
2993	CALL minmaxqfi2(d_tr_sscav(:, :, itr), qmin, qmax, 'd_tr_sscav:')
2994	CALL minmaxqfi2(d_tr_sat(:, :, itr), qmin, qmax, 'd_tr_sat:')
2995	CALL minmaxqfi2(d_tr_uscav(:, :, itr), qmin, qmax, 'd_tr_uscav:')
2996	IF (lcheckmass) THEN
2997	CALL checkmass(d_tr_cv(:, :, itr), RNAVO, masse(itr), zdz, &
2998	pplay, t_seri, .false., 'd_tr_cv:')
2999	ENDIF
3000	ENDIF
3001	ENDDO ! it=1,nbtr
3002
3003	ENDIF ! iflag_conv
3004	IF (lminmax) THEN
3005	DO itr = 1, nbtr
3006	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_trcon')
3007	ENDDO
3008	DO itr = 1, nbtr
3009	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after trconv')
3010	ENDDO
3011	IF (lcheckmass) THEN
3012	DO itr = 1, nbtr
3013	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3014	pplay, t_seri, iscm3, 'after trconv')
3015	ENDDO
3016	ENDIF
3017	CALL minmaxsource(source_tr, qmin, qmax, 'src: after trconv')
3018	ENDIF
3019	ENDIF ! convection
3020
3021	IF (logitime) THEN
3022	CALL SYSTEM_CLOCK(COUNT = clock_end)
3023	dife = clock_end - clock_start
3024	ti_cvltr = dife * MAX(0, SIGN(1, dife)) &
3025	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3026	tia_cvltr = tia_cvltr + REAL(ti_cvltr) / REAL(clock_rate)
3027	ENDIF
3028
3029
3030	!=======================================================================
3031	! LARGE SCALE SCAVENGING KE
3032	!=======================================================================
3033
3034	#ifdef IOPHYS_DUST
3035	call iophys_ecrit('da',klev,'da','',da)
3036	call iophys_ecrit('phi',klev,'phi','',phi)
3037	call iophys_ecrit('phi2',klev,'phi2','',phi2)
3038	call iophys_ecrit('d1a',klev,'d1a','',d1a)
3039	call iophys_ecrit('dam',klev,'dam','',dam)
3040	call iophys_ecrit('mp',klev,'mp','',mp)
3041	call iophys_ecrit('ep',klev,'ep','',ep)
3042	call iophys_ecrit('sigd',klev,'sigd','',sigd)
3043	call iophys_ecrit('sij',klev,'sij','',sij)
3044	call iophys_ecrit('wght_cvfd',klev,'wght_cvfd','',wght_cvfd)
3045	call iophys_ecrit('clw',klev,'clw','',clw)
3046	call iophys_ecrit('elij',klev,'elij','',elij)
3047	call iophys_ecrit('epmlmMm',klev,'epmlmMm','',epmlmMm)
3048	call iophys_ecrit('eplaMm',klev,'eplaMm','',eplaMm)
3049	call iophys_ecrit('pmflxr',klev,'pmflxr','',pmflxr)
3050	call iophys_ecrit('pmflxs',klev,'pmflxs','',pmflxs)
3051	call iophys_ecrit('evapls',klev,'evapls','',evapls)
3052	call iophys_ecrit('wdtrainA',klev,'wdtrainA','',wdtrainA)
3053	call iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM)
3054
3055	do itr=1,nbtr
3056	write(str2,'(i2.2)') itr
3057	call iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3058	enddo
3059	#endif
3060
3061
3062	IF (iflag_conv>=3) THEN
3063	IF (logitime) THEN
3064	CALL SYSTEM_CLOCK(COUNT = clock_start)
3065	ENDIF
3066
3067	IF (lessivage) THEN
3068	print *, ' BEFORE lsc_scav '
3069	IF (lminmax) THEN
3070	DO itr = 1, nbtr
3071	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_lsc_scav')
3072	ENDDO
3073	DO itr = 1, nbtr
3074	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before lsc_scav')
3075	ENDDO
3076	IF (lcheckmass) THEN
3077	DO itr = 1, nbtr
3078	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3079	pplay, t_seri, iscm3, 'before lsc_scav')
3080	ENDDO
3081	ENDIF
3082	CALL minmaxsource(source_tr, qmin, qmax, 'src: before lsc_scav')
3083	ENDIF
3084
3085	ql_incloud_ref = 10.e-4
3086	ql_incloud_ref = 5.e-4
3087	! calcul du contenu en eau liquide au sein du nuage
3088	ql_incl = ql_incloud_ref
3089	! choix du lessivage
3090	IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
3091	!IF (.false.) THEN ! test #DFB (Binta) sans lsc_scav_spl
3092	print *, 'JE iflag_lscav', iflag_lscav
3093	DO itr = 1, nbtr
3094
3095	! incloud scavenging and removal by large scale rain ! orig : ql_incl
3096	! was replaced by 0.5e-3 kg/kg
3097	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
3098	! Liu (2001) proposed to use 1.5e-3 kg/kg
3099
3100	! CALL lsc_scav_orig(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,
3101	! . rneb,beta_fisrt, beta_v1,pplay,paprs,
3102	! . t_seri,tr_seri,d_tr_insc,
3103	! . d_tr_bcscav,d_tr_evapls,qPrls)
3104	CALL lsc_scav_spl(pdtphys, itr, iflag_lscav, ql_incl, prfl, psfl, &
3105	rneb, beta_fisrt, beta_v1, pplay, paprs, &
3106	t_seri, tr_seri, d_tr_insc, &
3107	alpha_r, alpha_s, kk, henry, &
3108	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3109	d_tr_bcscav, d_tr_evapls, qPrls)
3110
3111	!large scale scavenging tendency
3112	DO k = 1, klev
3113	DO i = 1, klon
3114	d_tr_ls(i, k, itr) = d_tr_insc(i, k, itr) + d_tr_bcscav(i, k, itr) &
3115	+ d_tr_evapls(i, k, itr)
3116	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr_ls(i, k, itr)
3117	tmp_var(i, k) = d_tr_ls(i, k, itr)
3118	ENDDO
3119	ENDDO
3120
3121	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3122
3123	DO k = 1, klev
3124	DO i = 1, klon
3125	his_dhkelsc(i, itr) = his_dhkelsc(i, itr) - tmp_var(i, k) &
3126	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3127
3128	END DO
3129	END DO
3130
3131	END DO !it=1,nbtr
3132
3133	ELSE
3134	print *, 'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
3135	DO itr = 1, nbtr
3136	DO i = 1, klon
3137	his_dhkelsc(i, itr) = 0.0
3138	END DO ! klon
3139	END DO !it=1,nbtr
3140	ENDIF !iflag_lscav
3141
3142	print *, ' AFTER lsc_scav '
3143	IF (lminmax) THEN
3144	DO itr = 1, nbtr
3145	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_lsc_scav')
3146	ENDDO
3147	DO itr = 1, nbtr
3148	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after lsc_scav')
3149	ENDDO
3150	IF (lcheckmass) THEN
3151	DO itr = 1, nbtr
3152	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3153	pplay, t_seri, iscm3, 'after lsc_scav')
3154	ENDDO
3155	ENDIF
3156	CALL minmaxsource(source_tr, qmin, qmax, 'src: after lsc_scav')
3157	ENDIF
3158
3159	ENDIF ! lessivage
3160
3161	IF (logitime) THEN
3162	CALL SYSTEM_CLOCK(COUNT = clock_end)
3163	dife = clock_end - clock_start
3164	ti_lscs = dife * MAX(0, SIGN(1, dife)) &
3165	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3166	tia_lscs = tia_lscs + REAL(ti_lscs) / REAL(clock_rate)
3167	ENDIF
3168
3169	ENDIF !iflag_conv
3170
3171
3172	!=======================================================================
3173	! COMPUTING THE BURDEN
3174	!=======================================================================
3175	#ifdef IOPHYS_DUST
3176	do itr=1,nbtr
3177	write(str2,'(i2.2)') itr
3178	call iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3179	enddo
3180	#endif
3181
3182	IF (logitime) THEN
3183	CALL SYSTEM_CLOCK(COUNT = clock_start)
3184	ENDIF
3185
3186	DO itr = 1, nbtr
3187	DO j = 1, klev
3188	DO i = 1, klon
3189	tmp_var(i, j) = tr_seri(i, j, itr)
3190	ENDDO
3191	ENDDO
3192	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3193	DO j = 1, klev
3194	DO i = 1, klon
3195	tr_seri(i, j, itr) = tmp_var(i, j)
3196	ENDDO
3197	ENDDO
3198	ENDDO
3199	iscm3 = .true.
3200
3201	! Computing burden in mg/m2
3202	DO itr = 1, nbtr
3203	DO k = 1, klev
3204	DO i = 1, klon
3205	trm(i, itr) = trm(i, itr) + tr_seri(i, k, itr) * 1.e6 * zdz(i, k) * &
3206	masse(itr) * 1.e3 / RNAVO !--mg S/m2
3207	ENDDO
3208	ENDDO
3209	ENDDO
3210
3211	! Computing Surface concentration in ug/m3
3212
3213	DO itr = 1, nbtr
3214	DO i = 1, klon
3215	sconc_seri(i, itr) = tr_seri(i, 1, itr) * 1.e6 * &
3216	masse(itr) * 1.e3 / RNAVO !--mg/m3 (tr_seri ist in g/cm3)
3217	ENDDO
3218	ENDDO
3219
3220	!=======================================================================
3221	! CALCULATION OF OPTICAL PROPERTIES
3222	!=======================================================================
3223
3224	CALL aeropt_spl(zdz, tr_seri, RHcl, &
3225	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3226	ok_chimeredust, &
3227	diff_aod550_tot, diag_aod670_tot, diag_aod865_tot, &
3228	diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, &
3229	diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, &
3230	diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, &
3231	diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco)
3232
3233	IF (logitime) THEN
3234	CALL SYSTEM_CLOCK(COUNT = clock_end)
3235	dife = clock_end - clock_start
3236	ti_brop = dife * MAX(0, SIGN(1, dife)) &
3237	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3238	tia_brop = tia_brop + REAL(ti_brop) / REAL(clock_rate)
3239	ENDIF
3240
3241
3242	!=======================================================================
3243	! MODIS terra/aqua simulation output
3244	!=======================================================================
3245	masque_aqua_cur(:) = 0
3246	masque_terra_cur(:) = 0
3247
3248	CALL satellite_out_spla(jD_cur, jH_cur, pdtphys, rlat, rlon, &
3249	masque_aqua_cur, masque_terra_cur)
3250	IF (jH_cur - pdtphys / 86400. < 0.) THEN
3251	!new utc day: put in 0 everything
3252	!JE20150518<<
3253	masque_aqua(:) = 0
3254	masque_terra(:) = 0
3255	aod550_terra(:) = 0.
3256	aod550_tr2_terra(:) = 0.
3257	aod550_ss_terra(:) = 0.
3258	aod550_dust_terra(:) = 0.
3259	aod550_dustsco_terra(:) = 0.
3260	aod670_terra(:) = 0.
3261	aod670_tr2_terra(:) = 0.
3262	aod670_ss_terra(:) = 0.
3263	aod670_dust_terra(:) = 0.
3264	aod670_dustsco_terra(:) = 0.
3265	aod865_terra(:) = 0.
3266	aod865_tr2_terra(:) = 0.
3267	aod865_ss_terra(:) = 0.
3268	aod865_dust_terra(:) = 0.
3269	aod865_dustsco_terra(:) = 0.
3270	aod550_aqua(:) = 0.
3271	aod550_tr2_aqua(:) = 0.
3272	aod550_ss_aqua(:) = 0.
3273	aod550_dust_aqua(:) = 0.
3274	aod550_dustsco_aqua(:) = 0.
3275	aod670_aqua(:) = 0.
3276	aod670_tr2_aqua(:) = 0.
3277	aod670_ss_aqua(:) = 0.
3278	aod670_dust_aqua(:) = 0.
3279	aod670_dustsco_aqua(:) = 0.
3280	aod865_aqua(:) = 0.
3281	aod865_tr2_aqua(:) = 0.
3282	aod865_ss_aqua(:) = 0.
3283	aod865_dust_aqua(:) = 0.
3284	aod865_dustsco_aqua(:) = 0.
3285	!JE20150518>>
3286	ENDIF
3287
3288	DO i = 1, klon
3289
3290	aod550_terra(i) = aod550_terra(i) + &
3291	masque_terra_cur(i) * diff_aod550_tot(i)
3292	aod550_tr2_terra(i) = aod550_tr2_terra(i) + &
3293	masque_terra_cur(i) * diff_aod550_tr2(i)
3294	aod550_ss_terra(i) = aod550_ss_terra(i) + &
3295	masque_terra_cur(i) * diag_aod550_ss(i)
3296	aod550_dust_terra(i) = aod550_dust_terra(i) + &
3297	masque_terra_cur(i) * diag_aod550_dust(i)
3298	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) + &
3299	masque_terra_cur(i) * diag_aod550_dustsco(i)
3300	aod670_terra(i) = aod670_terra(i) + &
3301	masque_terra_cur(i) * diag_aod670_tot(i)
3302	aod670_tr2_terra(i) = aod670_tr2_terra(i) + &
3303	masque_terra_cur(i) * diag_aod670_tr2(i)
3304	aod670_ss_terra(i) = aod670_ss_terra(i) + &
3305	masque_terra_cur(i) * diag_aod670_ss(i)
3306	aod670_dust_terra(i) = aod670_dust_terra(i) + &
3307	masque_terra_cur(i) * diag_aod670_dust(i)
3308	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) + &
3309	masque_terra_cur(i) * diag_aod670_dustsco(i)
3310	aod865_terra(i) = aod865_terra(i) + &
3311	masque_terra_cur(i) * diag_aod865_tot(i)
3312	aod865_tr2_terra(i) = aod865_tr2_terra(i) + &
3313	masque_terra_cur(i) * diag_aod865_tr2(i)
3314	aod865_ss_terra(i) = aod865_ss_terra(i) + &
3315	masque_terra_cur(i) * diag_aod865_ss(i)
3316	aod865_dust_terra(i) = aod865_dust_terra(i) + &
3317	masque_terra_cur(i) * diag_aod865_dust(i)
3318	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) + &
3319	masque_terra_cur(i) * diag_aod865_dustsco(i)
3320
3321	aod550_aqua(i) = aod550_aqua(i) + &
3322	masque_aqua_cur(i) * diff_aod550_tot(i)
3323	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) + &
3324	masque_aqua_cur(i) * diff_aod550_tr2(i)
3325	aod550_ss_aqua(i) = aod550_ss_aqua(i) + &
3326	masque_aqua_cur(i) * diag_aod550_ss(i)
3327	aod550_dust_aqua(i) = aod550_dust_aqua(i) + &
3328	masque_aqua_cur(i) * diag_aod550_dust(i)
3329	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) + &
3330	masque_aqua_cur(i) * diag_aod550_dustsco(i)
3331	aod670_aqua(i) = aod670_aqua(i) + &
3332	masque_aqua_cur(i) * diag_aod670_tot(i)
3333	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) + &
3334	masque_aqua_cur(i) * diag_aod670_tr2(i)
3335	aod670_ss_aqua(i) = aod670_ss_aqua(i) + &
3336	masque_aqua_cur(i) * diag_aod670_ss(i)
3337	aod670_dust_aqua(i) = aod670_dust_aqua(i) + &
3338	masque_aqua_cur(i) * diag_aod670_dust(i)
3339	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) + &
3340	masque_aqua_cur(i) * diag_aod670_dustsco(i)
3341	aod865_aqua(i) = aod865_aqua(i) + &
3342	masque_aqua_cur(i) * diag_aod865_tot(i)
3343	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) + &
3344	masque_aqua_cur(i) * diag_aod865_tr2(i)
3345	aod865_ss_aqua(i) = aod865_ss_aqua(i) + &
3346	masque_aqua_cur(i) * diag_aod865_ss(i)
3347	aod865_dust_aqua(i) = aod865_dust_aqua(i) + &
3348	masque_aqua_cur(i) * diag_aod865_dust(i)
3349	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) + &
3350	masque_aqua_cur(i) * diag_aod865_dustsco(i)
3351
3352	masque_aqua(i) = masque_aqua(i) + masque_aqua_cur(i)
3353	masque_terra(i) = masque_terra(i) + masque_terra_cur(i)
3354	ENDDO
3355
3356	IF (jH_cur + pdtphys / 86400. >= 1.) THEN
3357	! print *,'last step of the day'
3358	DO i = 1, klon
3359	IF (masque_aqua(i)> 0) THEN
3360	aod550_aqua(i) = aod550_aqua(i) / masque_aqua(i)
3361	aod670_aqua(i) = aod670_aqua(i) / masque_aqua(i)
3362	aod865_aqua(i) = aod865_aqua(i) / masque_aqua(i)
3363	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) / masque_aqua(i)
3364	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) / masque_aqua(i)
3365	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) / masque_aqua(i)
3366	aod550_ss_aqua(i) = aod550_ss_aqua(i) / masque_aqua(i)
3367	aod670_ss_aqua(i) = aod670_ss_aqua(i) / masque_aqua(i)
3368	aod865_ss_aqua(i) = aod865_ss_aqua(i) / masque_aqua(i)
3369	aod550_dust_aqua(i) = aod550_dust_aqua(i) / masque_aqua(i)
3370	aod670_dust_aqua(i) = aod670_dust_aqua(i) / masque_aqua(i)
3371	aod865_dust_aqua(i) = aod865_dust_aqua(i) / masque_aqua(i)
3372	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) / masque_aqua(i)
3373	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) / masque_aqua(i)
3374	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) / masque_aqua(i)
3375	ELSE
3376	aod550_aqua(i) = -999.
3377	aod670_aqua(i) = -999.
3378	aod865_aqua(i) = -999.
3379	aod550_tr2_aqua(i) = -999.
3380	aod670_tr2_aqua(i) = -999.
3381	aod865_tr2_aqua(i) = -999.
3382	aod550_ss_aqua(i) = -999.
3383	aod670_ss_aqua(i) = -999.
3384	aod865_ss_aqua(i) = -999.
3385	aod550_dust_aqua(i) = -999.
3386	aod670_dust_aqua(i) = -999.
3387	aod865_dust_aqua(i) = -999.
3388	aod550_dustsco_aqua(i) = -999.
3389	aod670_dustsco_aqua(i) = -999.
3390	aod865_dustsco_aqua(i) = -999.
3391	ENDIF
3392	IF (masque_terra(i)> 0) THEN
3393	aod550_terra(i) = aod550_terra(i) / masque_terra(i)
3394	aod670_terra(i) = aod670_terra(i) / masque_terra(i)
3395	aod865_terra(i) = aod865_terra(i) / masque_terra(i)
3396	aod550_tr2_terra(i) = aod550_tr2_terra(i) / masque_terra(i)
3397	aod670_tr2_terra(i) = aod670_tr2_terra(i) / masque_terra(i)
3398	aod865_tr2_terra(i) = aod865_tr2_terra(i) / masque_terra(i)
3399	aod550_ss_terra(i) = aod550_ss_terra(i) / masque_terra(i)
3400	aod670_ss_terra(i) = aod670_ss_terra(i) / masque_terra(i)
3401	aod865_ss_terra(i) = aod865_ss_terra(i) / masque_terra(i)
3402	aod550_dust_terra(i) = aod550_dust_terra(i) / masque_terra(i)
3403	aod670_dust_terra(i) = aod670_dust_terra(i) / masque_terra(i)
3404	aod865_dust_terra(i) = aod865_dust_terra(i) / masque_terra(i)
3405	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) / masque_terra(i)
3406	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) / masque_terra(i)
3407	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) / masque_terra(i)
3408	ELSE
3409	aod550_terra(i) = -999.
3410	aod670_terra(i) = -999.
3411	aod865_terra(i) = -999.
3412	aod550_tr2_terra(i) = -999.
3413	aod670_tr2_terra(i) = -999.
3414	aod865_tr2_terra(i) = -999.
3415	aod550_ss_terra(i) = -999.
3416	aod670_ss_terra(i) = -999.
3417	aod865_ss_terra(i) = -999.
3418	aod550_dust_terra(i) = -999.
3419	aod670_dust_terra(i) = -999.
3420	aod865_dust_terra(i) = -999.
3421	aod550_dustsco_terra(i) = -999.
3422	aod670_dustsco_terra(i) = -999.
3423	aod865_dustsco_terra(i) = -999.
3424	ENDIF
3425	ENDDO
3426
3427	!!AS deleting lines
3428	!! IF (ok_histrac) THEN
3429	!!!! write in output file
3430	!!----many deleted lines
3431	!! ENDIF !mpi_root
3432	!!!$OMP END MASTER
3433	!!!$OMP BARRIER
3434	!! ENDIF !--ok_histrac
3435
3436	ENDIF ! jH_cur...
3437
3438	!======================================================================
3439	! Stockage sur bande histoire
3440	!======================================================================
3441	#ifdef IOPHYS_DUST
3442	do itr=1,nbtr
3443	write(str2,'(i2.2)') itr
3444	call iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3445	enddo
3446	#endif
3447
3448	IF (logitime) THEN
3449	CALL SYSTEM_CLOCK(COUNT = clock_start)
3450	ENDIF
3451
3452	DO itr = 1, nbtr
3453	DO j = 1, klev
3454	DO i = 1, klon
3455	tmp_var(i, j) = tr_seri(i, j, itr)
3456	ENDDO
3457	ENDDO
3458	CALL cm3_to_kg(pplay, t_seri, tmp_var)
3459	DO j = 1, klev
3460	DO i = 1, klon
3461	tr_seri(i, j, itr) = tmp_var(i, j)
3462	ENDDO
3463	ENDDO
3464	ENDDO
3465	iscm3 = .false.
3466
3467
3468	!======================================================================
3469	! SAVING AEROSOL RELATED VARIABLES INTO FILE
3470	!======================================================================
3471
3472	ndex2d = 0
3473	ndex3d = 0
3474
3475	itra = itra + 1
3476
3477	print *, 'SAVING VARIABLES FOR DAY ', itra
3478
3479	fluxbb(:) = 0.0
3480	fluxff(:) = 0.0
3481	fluxbcbb(:) = 0.0
3482	fluxbcff(:) = 0.0
3483	fluxbcnff(:) = 0.0
3484	fluxbcba(:) = 0.0
3485	fluxbc(:) = 0.0
3486	fluxombb(:) = 0.0
3487	fluxomff(:) = 0.0
3488	fluxomnat(:) = 0.0
3489	fluxomba(:) = 0.0
3490	fluxomnff(:) = 0.0
3491	fluxom(:) = 0.0
3492	fluxh2sff(:) = 0.0
3493	fluxh2snff(:) = 0.0
3494	fluxh2sbio(:) = 0.0
3495	fluxso2ff(:) = 0.0
3496	fluxso2nff(:) = 0.0
3497	fluxso2bb(:) = 0.0
3498	fluxso2vol(:) = 0.0
3499	fluxso2ba(:) = 0.0
3500	fluxso2(:) = 0.0
3501	fluxso4ff(:) = 0.0
3502	fluxso4nff(:) = 0.0
3503	fluxso4bb(:) = 0.0
3504	fluxso4ba(:) = 0.0
3505	fluxso4(:) = 0.0
3506	fluxdms(:) = 0.0
3507	fluxdustec(:) = 0.0
3508	fluxddfine(:) = 0.0
3509	fluxddcoa(:) = 0.0
3510	fluxddsco(:) = 0.0
3511	fluxdd(:) = 0.0
3512	fluxssfine(:) = 0.0
3513	fluxsscoa(:) = 0.0
3514	fluxss(:) = 0.0
3515	DO i = 1, klon
3516	IF (iregion_ind(i)>0) THEN ! LAND
3517	! SULFUR EMISSIONS
3518	fluxh2sff(i) = (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * frach2sofso2 * &
3519	scale_param_ind(iregion_ind(i)) * &
3520	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3521	fluxso2ff(i) = scale_param_ind(iregion_ind(i)) * fracso2emis * &
3522	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3523	masse_s * 1.e3 ! mgS/m2/s
3524	! SULPHATE EMISSIONS
3525	fluxso4ff(i) = scale_param_ind(iregion_ind(i)) * (1 - fracso2emis) * &
3526	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3527	masse_s * 1.e3 ! mgS/m2/s
3528	! BLACK CARBON EMISSIONS
3529	fluxbcff(i) = scale_param_ff(iregion_ind(i)) * &
3530	lmt_bcff(i) * 1.e4 * 1.e3 !/g/m2/s
3531	! ORGANIC MATTER EMISSIONS
3532	fluxomff(i) = scale_param_ff(iregion_ind(i)) * &
3533	(lmt_omff(i)) * 1.e4 * 1.e3 !/g/m2/s
3534	! FOSSIL FUEL EMISSIONS
3535	fluxff(i) = fluxbcff(i) + fluxomff(i)
3536	ENDIF
3537	IF (iregion_bb(i)>0) THEN ! LAND
3538	! SULFUR EMISSIONS
3539	fluxso2bb(i) = scale_param_bb(iregion_bb(i)) * fracso2emis * &
3540	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3541	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3542	! SULPHATE EMISSIONS
3543	fluxso4bb(i) = scale_param_bb(iregion_bb(i)) * (1 - fracso2emis) * &
3544	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3545	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3546	! BLACK CARBON EMISSIONS
3547	fluxbcbb(i) = scale_param_bb(iregion_bb(i)) * &
3548	(lmt_bcbb_l(i) + lmt_bcbb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3549	! ORGANIC MATTER EMISSIONS
3550	fluxombb(i) = scale_param_bb(iregion_bb(i)) * &
3551	(lmt_ombb_l(i) + lmt_ombb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3552	! BIOMASS BURNING EMISSIONS
3553	fluxbb(i) = fluxbcbb(i) + fluxombb(i)
3554	ENDIF
3555	! H2S EMISSIONS
3556	fluxh2sbio(i) = lmt_h2sbio(i) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3557	fluxh2snff(i) = lmt_so2nff(i) * frach2sofso2 * &
3558	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3559	! SULFUR DIOXIDE EMISSIONS
3560	fluxso2nff(i) = fracso2emis * lmt_so2nff(i) * 1.e4 / RNAVO * &
3561	masse_s * 1.e3 ! mgS/m2/s
3562	fluxso2vol(i) = (lmt_so2volc_cont(i) + lmt_so2volc_expl(i)) &
3563	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3564	fluxso2ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 * &
3565	fracso2emis ! mgS/m2/s
3566	fluxso2(i) = fluxso2ff(i) + fluxso2bb(i) + fluxso2nff(i) + &
3567	fluxso2vol(i) + fluxso2ba(i)
3568	! DMS EMISSIONS
3569	fluxdms(i) = (lmt_dms(i) + lmt_dmsbio(i)) &
3570	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3571	! SULPHATE EMISSIONS
3572	fluxso4ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 &
3573	* (1 - fracso2emis) ! mgS/m2/s
3574	fluxso4nff(i) = (1 - fracso2emis) * lmt_so2nff(i) * 1.e4 / RNAVO * &
3575	masse_s * 1.e3 ! mgS/m2/s
3576	fluxso4(i) = fluxso4ff(i) + fluxso4bb(i) + fluxso4ba(i) + fluxso4nff(i)
3577	! BLACK CARBON EMISSIONS
3578
3579	fluxbcnff(i) = lmt_bcnff(i) * 1.e4 * 1.e3 !mg/m2/s
3580	fluxbcba(i) = lmt_bcba(i) * 1.e4 * 1.e3 !mg/m2/s
3581	fluxbc(i) = fluxbcbb(i) + fluxbcff(i) + fluxbcnff(i) + fluxbcba(i)
3582	! ORGANIC MATTER EMISSIONS
3583	fluxomnat(i) = lmt_omnat(i) * 1.e4 * 1.e3 !mg/m2/s
3584	fluxomba(i) = lmt_omba(i) * 1.e4 * 1.e3 !mg/m2/s
3585	fluxomnff(i) = lmt_omnff(i) * 1.e4 * 1.e3 !mg/m2/s
3586	fluxom(i) = fluxombb(i) + fluxomff(i) + fluxomnat(i) + fluxomba(i) + &
3587	fluxomnff(i)
3588	! DUST EMISSIONS
3589	fluxdustec(i) = dust_ec(i) * 1.e6 ! old dust emission scheme
3590	!JE20140605<< old dust emission version
3591	! fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
3592	! . * dust_ec(i)0.0931.e6
3593	! fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
3594	! . * dust_ec(i)0.9051.e6
3595	! fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
3596	!JE20140605>>
3597	fluxddfine(i) = flux_sparam_ddfine(i)
3598	fluxddcoa(i) = flux_sparam_ddcoa(i)
3599	fluxddsco(i) = flux_sparam_ddsco(i)
3600	fluxdd(i) = fluxddfine(i) + fluxddcoa(i) + fluxddsco(i)
3601	! SEA SALT EMISSIONS
3602	fluxssfine(i) = scale_param_ssacc * lmt_sea_salt(i, 1) * 1.e4 * 1.e3
3603	fluxsscoa(i) = scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3
3604	fluxss(i) = fluxssfine(i) + fluxsscoa(i)
3605	ENDDO
3606
3607	! prepare outputs cvltr
3608
3609	DO itr = 1, nbtr
3610	DO k = 1, klev
3611	DO i = 1, klon
3612	tmp_var(i, k) = d_tr_cv(i, k, itr)
3613	ENDDO
3614	ENDDO
3615	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3616	DO k = 1, klev
3617	DO i = 1, klon
3618	d_tr_cv_o(i, k, itr) = tmp_var(i, k) &
3619	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3620	ENDDO
3621	ENDDO
3622	ENDDO
3623	DO itr = 1, nbtr
3624	DO k = 1, klev
3625	DO i = 1, klon
3626	tmp_var(i, k) = d_tr_trsp(i, k, itr)
3627	ENDDO
3628	ENDDO
3629	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3630	DO k = 1, klev
3631	DO i = 1, klon
3632	d_tr_trsp_o(i, k, itr) = tmp_var(i, k) &
3633	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3634	ENDDO
3635	ENDDO
3636	ENDDO
3637	DO itr = 1, nbtr
3638	DO k = 1, klev
3639	DO i = 1, klon
3640	tmp_var(i, k) = d_tr_sscav(i, k, itr)
3641	ENDDO
3642	ENDDO
3643	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3644	DO k = 1, klev
3645	DO i = 1, klon
3646	d_tr_sscav_o(i, k, itr) = tmp_var(i, k) &
3647	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3648	ENDDO
3649	ENDDO
3650	ENDDO
3651	DO itr = 1, nbtr
3652	DO k = 1, klev
3653	DO i = 1, klon
3654	tmp_var(i, k) = d_tr_sat(i, k, itr)
3655	ENDDO
3656	ENDDO
3657	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3658	DO k = 1, klev
3659	DO i = 1, klon
3660	d_tr_sat_o(i, k, itr) = tmp_var(i, k) &
3661	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3662	ENDDO
3663	ENDDO
3664	ENDDO
3665	DO itr = 1, nbtr
3666	DO k = 1, klev
3667	DO i = 1, klon
3668	tmp_var(i, k) = d_tr_uscav(i, k, itr)
3669	ENDDO
3670	ENDDO
3671	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3672	DO k = 1, klev
3673	DO i = 1, klon
3674	d_tr_uscav_o(i, k, itr) = tmp_var(i, k) &
3675	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3676	ENDDO
3677	ENDDO
3678	ENDDO
3679	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3680	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3681	DO itr = 1, nbtr
3682	DO k = 1, klev
3683	DO i = 1, klon
3684	tmp_var(i, k) = d_tr_insc(i, k, itr)
3685	ENDDO
3686	ENDDO
3687	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3688	DO k = 1, klev
3689	DO i = 1, klon
3690	d_tr_insc_o(i, k, itr) = tmp_var(i, k) &
3691	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3692	ENDDO
3693	ENDDO
3694	ENDDO
3695
3696	DO itr = 1, nbtr
3697	DO k = 1, klev
3698	DO i = 1, klon
3699	tmp_var(i, k) = d_tr_bcscav(i, k, itr)
3700	ENDDO
3701	ENDDO
3702	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3703	DO k = 1, klev
3704	DO i = 1, klon
3705	d_tr_bcscav_o(i, k, itr) = tmp_var(i, k) &
3706	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3707	ENDDO
3708	ENDDO
3709	ENDDO
3710
3711	DO itr = 1, nbtr
3712	DO k = 1, klev
3713	DO i = 1, klon
3714	tmp_var(i, k) = d_tr_evapls(i, k, itr)
3715	ENDDO
3716	ENDDO
3717	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3718	DO k = 1, klev
3719	DO i = 1, klon
3720	d_tr_evapls_o(i, k, itr) = tmp_var(i, k) &
3721	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3722	ENDDO
3723	ENDDO
3724	ENDDO
3725
3726	DO itr = 1, nbtr
3727	DO k = 1, klev
3728	DO i = 1, klon
3729	tmp_var(i, k) = d_tr_ls(i, k, itr)
3730	ENDDO
3731	ENDDO
3732	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3733	DO k = 1, klev
3734	DO i = 1, klon
3735	d_tr_ls_o(i, k, itr) = tmp_var(i, k) &
3736	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3737	ENDDO
3738	ENDDO
3739	ENDDO
3740
3741	DO itr = 1, nbtr
3742	DO k = 1, klev
3743	DO i = 1, klon
3744	tmp_var(i, k) = d_tr_dyn(i, k, itr)
3745	ENDDO
3746	ENDDO
3747	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3748	DO k = 1, klev
3749	DO i = 1, klon
3750	d_tr_dyn_o(i, k, itr) = tmp_var(i, k) &
3751	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3752	ENDDO
3753	ENDDO
3754	ENDDO
3755
3756	DO itr = 1, nbtr
3757	DO k = 1, klev
3758	DO i = 1, klon
3759	tmp_var(i, k) = d_tr_cl(i, k, itr)
3760	ENDDO
3761	ENDDO
3762	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3763	DO k = 1, klev
3764	DO i = 1, klon
3765	d_tr_cl_o(i, k, itr) = tmp_var(i, k) &
3766	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3767	ENDDO
3768	ENDDO
3769	ENDDO
3770
3771	DO itr = 1, nbtr
3772	DO k = 1, klev
3773	DO i = 1, klon
3774	tmp_var(i, k) = d_tr_th(i, k, itr)
3775	ENDDO
3776	ENDDO
3777	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3778	DO k = 1, klev
3779	DO i = 1, klon
3780	d_tr_th_o(i, k, itr) = tmp_var(i, k) &
3781	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3782	ENDDO
3783	ENDDO
3784	ENDDO
3785	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3786	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3787
3788	DO itr = 1, nbtr
3789	WRITE(str2, '(i2.2)') itr
3790	DO i = 1, klon
3791	his_dh(i, itr) = his_dhlsc(i, itr) + his_dhcon(i, itr) + &
3792	his_dhbclsc(i, itr) + his_dhbccon(i, itr)
3793
3794	ENDDO
3795	ENDDO
3796
3797	!AS: commenting out and deleting lines
3798	!! IF (ok_histrac) THEN
3799	!!
3800	!! SAVING VARIABLES IN TRACEUR
3801	!!----- many lines deleted----
3802	!! ENDIF ! ok_histrac
3803
3804
3805
3806
3807	!JE20141224
3808	! saving variables for output
3809	! 2D outputs
3810	DO i = 1, klon
3811	trm01(i) = 0.
3812	trm02(i) = 0.
3813	trm03(i) = 0.
3814	trm04(i) = 0.
3815	trm05(i) = 0.
3816	sconc01(i) = 0.
3817	sconc02(i) = 0.
3818	sconc03(i) = 0.
3819	sconc04(i) = 0.
3820	sconc05(i) = 0.
3821	flux01(i) = 0.
3822	flux02(i) = 0.
3823	flux03(i) = 0.
3824	flux04(i) = 0.
3825	flux05(i) = 0.
3826	ds01(i) = 0.
3827	ds02(i) = 0.
3828	ds03(i) = 0.
3829	ds04(i) = 0.
3830	ds05(i) = 0.
3831	dh01(i) = 0.
3832	dh02(i) = 0.
3833	dh03(i) = 0.
3834	dh04(i) = 0.
3835	dh05(i) = 0.
3836	dtrconv01(i) = 0.
3837	dtrconv02(i) = 0.
3838	dtrconv03(i) = 0.
3839	dtrconv04(i) = 0.
3840	dtrconv05(i) = 0.
3841	dtherm01(i) = 0.
3842	dtherm02(i) = 0.
3843	dtherm03(i) = 0.
3844	dtherm04(i) = 0.
3845	dtherm05(i) = 0.
3846	dhkecv01(i) = 0.
3847	dhkecv02(i) = 0.
3848	dhkecv03(i) = 0.
3849	dhkecv04(i) = 0.
3850	dhkecv05(i) = 0.
3851	d_tr_ds01(i) = 0.
3852	d_tr_ds02(i) = 0.
3853	d_tr_ds03(i) = 0.
3854	d_tr_ds04(i) = 0.
3855	d_tr_ds05(i) = 0.
3856	dhkelsc01(i) = 0.
3857	dhkelsc02(i) = 0.
3858	dhkelsc03(i) = 0.
3859	dhkelsc04(i) = 0.
3860	dhkelsc05(i) = 0.
3861	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3862
3863	if(id_prec>0) trm01(i) = trm(i, id_prec)
3864	if(id_fine>0) trm02(i) = trm(i, id_fine)
3865	if(id_coss>0) trm03(i) = trm(i, id_coss)
3866	if(id_codu>0) trm04(i) = trm(i, id_codu)
3867	if(id_scdu>0) trm05(i) = trm(i, id_scdu)
3868	if(id_prec>0) sconc01(i) = sconc_seri(i, id_prec)
3869	if(id_fine>0) sconc02(i) = sconc_seri(i, id_fine)
3870	if(id_coss>0) sconc03(i) = sconc_seri(i, id_coss)
3871	if(id_codu>0) sconc04(i) = sconc_seri(i, id_codu)
3872	if(id_scdu>0) sconc05(i) = sconc_seri(i, id_scdu)
3873	if(id_prec>0) flux01(i) = flux_tr(i, id_prec)
3874	if(id_fine>0) flux02(i) = flux_tr(i, id_fine)
3875	if(id_coss>0) flux03(i) = flux_tr(i, id_coss)
3876	if(id_codu>0) flux04(i) = flux_tr(i, id_codu)
3877	if(id_scdu>0) flux05(i) = flux_tr(i, id_scdu)
3878	if(id_prec>0) ds01(i) = his_ds(i, id_prec)
3879	if(id_fine>0) ds02(i) = his_ds(i, id_fine)
3880	if(id_coss>0) ds03(i) = his_ds(i, id_coss)
3881	if(id_codu>0) ds04(i) = his_ds(i, id_codu)
3882	if(id_scdu>0) ds05(i) = his_ds(i, id_scdu)
3883	if(id_prec>0) dh01(i) = his_dh(i, id_prec)
3884	if(id_fine>0) dh02(i) = his_dh(i, id_fine)
3885	if(id_coss>0) dh03(i) = his_dh(i, id_coss)
3886	if(id_codu>0) dh04(i) = his_dh(i, id_codu)
3887	if(id_scdu>0) dh05(i) = his_dh(i, id_scdu)
3888	if(id_prec>0) dtrconv01(i) = dtrconv(i, id_prec)
3889	if(id_fine>0) dtrconv02(i) = dtrconv(i, id_fine)
3890	if(id_coss>0) dtrconv03(i) = dtrconv(i, id_coss)
3891	if(id_codu>0) dtrconv04(i) = dtrconv(i, id_codu)
3892	if(id_scdu>0) dtrconv05(i) = dtrconv(i, id_scdu)
3893	if(id_prec>0) dtherm01(i) = his_th(i, id_prec)
3894	if(id_fine>0) dtherm02(i) = his_th(i, id_fine)
3895	if(id_coss>0) dtherm03(i) = his_th(i, id_coss)
3896	if(id_codu>0) dtherm04(i) = his_th(i, id_codu)
3897	if(id_scdu>0) dtherm05(i) = his_th(i, id_scdu)
3898	if(id_prec>0) dhkecv01(i) = his_dhkecv(i, id_prec)
3899	if(id_fine>0) dhkecv02(i) = his_dhkecv(i, id_fine)
3900	if(id_coss>0) dhkecv03(i) = his_dhkecv(i, id_coss)
3901	if(id_codu>0) dhkecv04(i) = his_dhkecv(i, id_codu)
3902	if(id_scdu>0) dhkecv05(i) = his_dhkecv(i, id_scdu)
3903	if(id_prec>0) d_tr_ds01(i) = his_ds(i, id_prec)
3904	if(id_fine>0) d_tr_ds02(i) = his_ds(i, id_fine)
3905	if(id_coss>0) d_tr_ds03(i) = his_ds(i, id_coss)
3906	if(id_codu>0) d_tr_ds04(i) = his_ds(i, id_codu)
3907	if(id_scdu>0) d_tr_ds05(i) = his_ds(i, id_scdu)
3908	if(id_prec>0) dhkelsc01(i) = his_dhkelsc(i, id_prec)
3909	if(id_fine>0) dhkelsc02(i) = his_dhkelsc(i, id_fine)
3910	if(id_coss>0) dhkelsc03(i) = his_dhkelsc(i, id_coss)
3911	if(id_codu>0) dhkelsc04(i) = his_dhkelsc(i, id_codu)
3912	if(id_scdu>0) dhkelsc05(i) = his_dhkelsc(i, id_scdu)
3913	u10m_ss(i) = u10m_ec(i)
3914	v10m_ss(i) = v10m_ec(i)
3915	ENDDO
3916	! 3D outs
3917	DO i = 1, klon
3918	DO k = 1, klev
3919	d_tr_cv01(i, k) = 0.
3920	d_tr_cv02(i, k) = 0.
3921	d_tr_cv03(i, k) = 0.
3922	d_tr_cv04(i, k) = 0.
3923	d_tr_cv05(i, k) = 0.
3924	d_tr_trsp01(i, k) = 0.
3925	d_tr_trsp02(i, k) = 0.
3926	d_tr_trsp03(i, k) = 0.
3927	d_tr_trsp04(i, k) = 0.
3928	d_tr_trsp05(i, k) = 0.
3929	d_tr_sscav01(i, k) = 0.
3930	d_tr_sscav02(i, k) = 0.
3931	d_tr_sscav03(i, k) = 0.
3932	d_tr_sscav04(i, k) = 0.
3933	d_tr_sscav05(i, k) = 0.
3934	d_tr_sat01(i, k) = 0.
3935	d_tr_sat02(i, k) = 0.
3936	d_tr_sat03(i, k) = 0.
3937	d_tr_sat04(i, k) = 0.
3938	d_tr_sat05(i, k) = 0.
3939	d_tr_uscav01(i, k) = 0.
3940	d_tr_uscav02(i, k) = 0.
3941	d_tr_uscav03(i, k) = 0.
3942	d_tr_uscav04(i, k) = 0.
3943	d_tr_uscav05(i, k) = 0.
3944	d_tr_insc01(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3945	d_tr_insc02(i, k) = 0.
3946	d_tr_insc03(i, k) = 0.
3947	d_tr_insc04(i, k) = 0.
3948	d_tr_insc05(i, k) = 0.
3949	d_tr_bcscav01(i, k) = 0.
3950	d_tr_bcscav02(i, k) = 0.
3951	d_tr_bcscav03(i, k) = 0.
3952	d_tr_bcscav04(i, k) = 0.
3953	d_tr_bcscav05(i, k) = 0.
3954	d_tr_evapls01(i, k) = 0.
3955	d_tr_evapls02(i, k) = 0.
3956	d_tr_evapls03(i, k) = 0.
3957	d_tr_evapls04(i, k) = 0.
3958	d_tr_evapls05(i, k) = 0.
3959	d_tr_ls01(i, k) = 0.
3960	d_tr_ls02(i, k) = 0.
3961	d_tr_ls03(i, k) = 0.
3962	d_tr_ls04(i, k) = 0.
3963	d_tr_ls05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3964	d_tr_dyn01(i, k) = 0.
3965	d_tr_dyn02(i, k) = 0.
3966	d_tr_dyn03(i, k) = 0.
3967	d_tr_dyn04(i, k) = 0.
3968	d_tr_dyn05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3969	d_tr_cl01(i, k) = 0.
3970	d_tr_cl02(i, k) = 0.
3971	d_tr_cl03(i, k) = 0.
3972	d_tr_cl04(i, k) = 0.
3973	d_tr_cl05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3974	d_tr_th01(i, k) = 0.
3975	d_tr_th02(i, k) = 0.
3976	d_tr_th03(i, k) = 0.
3977	d_tr_th04(i, k) = 0.
3978	d_tr_th05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3979	ENDDO
3980	ENDDO
3981
3982	IF(1==0) THEN
3983	! calcul in original trunk version; problem: budget not closed. Corrected in "ELSE"
3984	DO i = 1, klon
3985	DO k = 1, klev
3986
3987	if(id_prec>0) d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
3988	if(id_fine>0) d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
3989	if(id_coss>0) d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
3990	if(id_codu>0) d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
3991	if(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
3992	if(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
3993	if(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
3994	if(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
3995	if(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
3996	if(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
3997	if(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
3998	if(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
3999	if(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
4000	if(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
4001	if(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
4002	if(id_prec>0) d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
4003	if(id_fine>0) d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
4004	if(id_coss>0) d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
4005	if(id_codu>0) d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
4006	if(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
4007	if(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
4008	if(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
4009	if(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
4010	if(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
4011	if(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
4012	if(id_prec>0) d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
4013	if(id_fine>0) d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
4014	if(id_coss>0) d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
4015	if(id_codu>0) d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
4016	if(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
4017	if(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
4018	if(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
4019	if(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
4020	if(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
4021	if(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
4022	if(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
4023	if(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
4024	if(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
4025	if(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
4026	if(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
4027	ENDDO
4028	ENDDO
4029	ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
4030	DO i = 1, klon
4031	DO k = 1, klev
4032	if(id_prec>0) d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
4033	if(id_fine>0) d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
4034	if(id_coss>0) d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
4035	if(id_codu>0) d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
4036	if(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
4037	if(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
4038	if(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
4039	if(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
4040	if(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
4041	if(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
4042	if(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
4043	if(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
4044	if(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
4045	if(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
4046	if(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
4047	if(id_prec>0) d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
4048	if(id_fine>0) d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
4049	if(id_coss>0) d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
4050	if(id_codu>0) d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
4051	if(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
4052	if(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
4053	if(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
4054	if(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
4055	if(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
4056	if(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
4057	if(id_prec>0) d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
4058	if(id_fine>0) d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
4059	if(id_coss>0) d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
4060	if(id_codu>0) d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
4061	if(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
4062	if(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
4063	if(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
4064	if(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
4065	if(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
4066	if(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
4067	if(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
4068	if(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
4069	if(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
4070	if(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
4071	if(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
4072	ENDDO
4073	ENDDO
4074	ENDIF
4075
4076	IF(1==0) THEN ! This "if" is as in original trunk
4077	DO i = 1, klon
4078	DO k = 1, klev
4079	if(id_prec>0) d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
4080	if(id_fine>0) d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
4081	if(id_coss>0) d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
4082	if(id_codu>0) d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
4083	if(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
4084	if(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
4085	if(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
4086	if(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
4087	if(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
4088	if(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
4089	if(id_prec>0) d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
4090	if(id_fine>0) d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
4091	if(id_coss>0) d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
4092	if(id_codu>0) d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
4093	if(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
4094	if(id_prec>0) d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
4095	if(id_fine>0) d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
4096	if(id_coss>0) d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
4097	if(id_codu>0) d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
4098	if(id_scdu>0) d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
4099	ENDDO
4100	ENDDO
4101	ELSE
4102	DO i = 1, klon
4103	DO k = 1, klev
4104	if(id_prec>0) d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
4105	if(id_fine>0) d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
4106	if(id_coss>0) d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
4107	if(id_codu>0) d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
4108	if(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
4109	if(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
4110	if(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
4111	if(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
4112	if(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
4113	if(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
4114	if(id_prec>0) d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
4115	if(id_fine>0) d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
4116	if(id_coss>0) d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
4117	if(id_codu>0) d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
4118	if(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
4119	if(id_prec>0) d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
4120	if(id_fine>0) d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
4121	if(id_coss>0) d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
4122	if(id_codu>0) d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
4123	if(id_scdu>0) d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
4124	ENDDO
4125	ENDDO
4126	ENDIF
4127
4128	IF (logitime) THEN
4129	CALL SYSTEM_CLOCK(COUNT = clock_end)
4130
4131	dife = clock_end - clock_start
4132	ti_outs = dife * MAX(0, SIGN(1, dife)) &
4133	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4134	tia_outs = tia_outs + REAL(ti_outs) / REAL(clock_rate)
4135	ENDIF
4136
4137	IF (logitime) THEN
4138	CALL SYSTEM_CLOCK(COUNT = clock_end)
4139
4140	dife = clock_end - clock_start_spla
4141	ti_spla = dife * MAX(0, SIGN(1, dife)) &
4142	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4143
4144	tia_spla = tia_spla + REAL(ti_spla) / REAL(clock_rate)
4145	print *, 'times for this timestep:timeproc,timeproc/time_pytracr_spl-'
4146	print *, 'time spla', REAL(ti_spla) / REAL(clock_rate) &
4147	, REAL(ti_spla) / REAL(ti_spla)
4148	print *, 'time init', REAL(ti_init) / REAL(clock_rate) &
4149	, REAL(ti_init) / REAL(ti_spla)
4150	print *, 'time inittype', REAL(ti_inittype) / REAL(clock_rate) &
4151	, REAL(ti_inittype) / REAL(ti_spla)
4152	print *, 'time inittwrite', REAL(ti_inittwrite) / REAL(clock_rate) &
4153	, REAL(ti_inittwrite) / REAL(ti_spla)
4154	print *, 'time emis', REAL(ti_emis) / REAL(clock_rate) &
4155	, REAL(ti_emis) / REAL(ti_spla)
4156	print *, 'time depo ', REAL(ti_depo) / REAL(clock_rate) &
4157	, REAL(ti_depo) / REAL(ti_spla)
4158	print *, 'time cltr', REAL(ti_cltr) / REAL(clock_rate) &
4159	, REAL(ti_cltr) / REAL(ti_spla)
4160	print *, 'time ther', REAL(ti_ther) / REAL(clock_rate) &
4161	, REAL(ti_ther) / REAL(ti_spla)
4162	print *, 'time sedi', REAL(ti_sedi) / REAL(clock_rate) &
4163	, REAL(ti_sedi) / REAL(ti_spla)
4164	print *, 'time gas to part', REAL(ti_gasp) / REAL(clock_rate) &
4165	, REAL(ti_gasp) / REAL(ti_spla)
4166	print *, 'time AP wet', REAL(ti_wetap) / REAL(clock_rate) &
4167	, REAL(ti_wetap) / REAL(ti_spla)
4168	print *, 'time convective', REAL(ti_cvltr) / REAL(clock_rate) &
4169	, REAL(ti_cvltr) / REAL(ti_spla)
4170	print *, 'time NP lsc scav', REAL(ti_lscs) / REAL(clock_rate) &
4171	, REAL(ti_lscs) / REAL(ti_spla)
4172	print *, 'time opt,brdn,etc', REAL(ti_brop) / REAL(clock_rate) &
4173	, REAL(ti_brop) / REAL(ti_spla)
4174	print *, 'time outputs', REAL(ti_outs) / REAL(clock_rate) &
4175	, REAL(ti_outs) / REAL(ti_spla)
4176
4177	print *, '--time accumulated: time proc, time proc/time phytracr_spl--'
4178	print *, 'time spla', tia_spla
4179	print *, 'time init', tia_init, tia_init / tia_spla
4180	print *, 'time inittype', tia_inittype, tia_inittype / tia_spla
4181	print *, 'time inittwrite', tia_inittwrite, tia_inittwrite / tia_spla
4182	print *, 'time emis', tia_emis, tia_emis / tia_spla
4183	print *, 'time depo', tia_depo, tia_depo / tia_spla
4184	print *, 'time cltr', tia_cltr, tia_cltr / tia_spla
4185	print *, 'time ther', tia_ther, tia_ther / tia_spla
4186	print *, 'time sedi', tia_sedi, tia_sedi / tia_spla
4187	print *, 'time gas to part', tia_gasp, tia_gasp / tia_spla
4188	print *, 'time AP wet', tia_wetap, tia_wetap / tia_spla
4189	print *, 'time convective', tia_cvltr, tia_cvltr / tia_spla
4190	print *, 'time NP lsc scav', tia_lscs, tia_lscs / tia_spla
4191	print *, 'time opt,brdn,etc', tia_brop, tia_brop / tia_spla
4192	print *, 'time outputs', tia_outs, tia_outs / tia_spla
4193
4194	dife = clock_end_outphytracr - clock_start_outphytracr
4195	ti_nophytracr = dife * MAX(0, SIGN(1, dife)) &
4196	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4197	tia_nophytracr = tia_nophytracr + REAL(ti_nophytracr) / REAL(clock_rate)
4198	print *, 'Time outside phytracr; Time accum outside phytracr'
4199	print*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
4200
4201	clock_start_outphytracr = clock_end
4202
4203	ENDIF
4204	print *, 'END PHYTRACR_SPL '
4205	print *, 'lmt_so2ff_l FIN', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
4206
4207	! CALL abort_gcm('TEST1', 'OK1', 1)
4208
4209	RETURN
4210	END SUBROUTINE phytracr_spl
4211
4212	SUBROUTINE readregionsdims2_spl(nbreg, fileregions)
4213
4214	USE mod_grid_phy_lmdz
4215	USE mod_phys_lmdz_para
4216
4217	IMPLICIT NONE
4218	CHARACTER*800 fileregions
4219	CHARACTER*800 auxstr
4220	INTEGER nbreg
4221
4222	IF (is_mpi_root .AND. is_omp_root) THEN
4223
4224	OPEN (UNIT = 1, FILE = trim(adjustl(fileregions)))
4225	READ(1, '(a)') auxstr
4226	READ(1, '(i10)') nbreg
4227	CLOSE(UNIT = 1)
4228	ENDIF
4229	CALL bcast(nbreg)
4230
4231	END SUBROUTINE readregionsdims2_spl
4232
4233	SUBROUTINE readregionsdims_spl(nbreg_ind, fileregionsdimsind, &
4234	nbreg_dust, fileregionsdimsdust, &
4235	nbreg_bb, fileregionsdimsbb)
4236	USE mod_grid_phy_lmdz
4237	USE mod_phys_lmdz_para
4238
4239	IMPLICIT NONE
4240	CHARACTER*800 fileregionsdimsind
4241	CHARACTER*800 fileregionsdimsdust
4242	CHARACTER*800 fileregionsdimsbb
4243	CHARACTER*800 auxstr
4244	INTEGER nbreg_ind, nbreg_dust, nbreg_bb
4245
4246	IF (is_mpi_root .AND. is_omp_root) THEN
4247
4248	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsind)))
4249	READ(1, '(a)') auxstr
4250	READ(1, '(i10)') nbreg_ind
4251	CLOSE(UNIT = 1)
4252
4253	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsdust)))
4254	READ(1, '(a)') auxstr
4255	READ(1, '(i10)') nbreg_dust
4256	CLOSE(UNIT = 1)
4257
4258	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsbb)))
4259	READ(1, '(a)') auxstr
4260	READ(1, '(i10)') nbreg_bb
4261	CLOSE(UNIT = 1)
4262
4263	ENDIF
4264	CALL bcast(nbreg_ind)
4265	CALL bcast(nbreg_dust)
4266	CALL bcast(nbreg_bb)
4267
4268	END SUBROUTINE readregionsdims_spl
4269
4270	SUBROUTINE readregions_spl(iregion, filenameregion)
4271	USE dimphy
4272	USE mod_grid_phy_lmdz
4273	USE mod_phys_lmdz_para
4274
4275	IMPLICIT NONE
4276	CHARACTER() filenameregion
4277	INTEGER iregion(klon)
4278	INTEGER iregion_glo(klon_glo)
4279	INTEGER k
4280
4281	IF (is_mpi_root .AND. is_omp_root) THEN
4282
4283	print *, trim(adjustl(filenameregion))
4284	OPEN(1, file = trim(adjustl(filenameregion)))
4285	DO k = 1, klon_glo
4286	READ(1, '(i10)') iregion_glo(k)
4287	ENDDO
4288	CLOSE(UNIT = 1)
4289	ENDIF
4290	CALL scatter(iregion_glo, iregion)
4291
4292	END SUBROUTINE readregions_spl
4293
4294	!! AS: SUBROUTINE readscaleparams_spl pas appellee
4295	SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
4296	filescaleparams)
4297	USE mod_grid_phy_lmdz
4298	USE mod_phys_lmdz_para
4299	IMPLICIT NONE
4300
4301	CHARACTER*800 filescaleparams
4302	INTEGER nbreg
4303	REAL scale_param(nbreg)
4304	INTEGER k
4305
4306	IF (is_mpi_root .AND. is_omp_root) THEN
4307	OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
4308	do k = 1, nbreg
4309	read(1) scale_param(k)
4310	enddo
4311	CLOSE(1)
4312	ENDIF
4313	CALL bcast(scale_param)
4314	! print *,'holaaaaaaaaaaaa'
4315	! print *,scale_param
4316
4317	END SUBROUTINE readscaleparams_spl
4318
4319	SUBROUTINE readscaleparamsnc_spl(scale_param_ind, &
4320	nbreg_ind, paramname_ind, &
4321	scale_param_ff, nbreg_ff, paramname_ff, &
4322	scale_param_bb, nbreg_bb, paramname_bb, &
4323	scale_param_dustacc, nbreg_dustacc, paramname_dustacc, &
4324	scale_param_dustcoa, nbreg_dustcoa, paramname_dustcoa, &
4325	scale_param_dustsco, nbreg_dustsco, paramname_dustsco, &
4326	param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL, &
4327	param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, &
4328	scale_param_ssacc, paramname_ssacc, &
4329	scale_param_sscoa, paramname_sscoa, &
4330	filescaleparams, julien, jH_phys, pdtphys, debutphy)
4331	! SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, &
4332	! filescaleparams,paramname,&
4333	! julien,jH_phys, pdtphys,debutphy)
4334	USE mod_grid_phy_lmdz
4335	USE mod_phys_lmdz_para
4336	IMPLICIT NONE
4337
4338	CHARACTER*800 filescaleparams
4339	CHARACTER*100 paramname_ind, paramname_ff, paramname_bb
4340	CHARACTER*100 paramname_dustacc, paramname_dustcoa
4341	CHARACTER*100 paramname_dustsco
4342	CHARACTER*100 paramname_ssacc
4343	CHARACTER*100 paramname_sscoa
4344	CHARACTER*100 paramname_wstarBL
4345	CHARACTER*100 paramname_wstarWAKE
4346
4347	INTEGER nbreg, iday
4348	INTEGER nbreg_ind, nbreg_ff, nbreg_bb, nbreg_dustacc
4349	INTEGER nbreg_dustcoa, nbreg_dustsco, nbreg_wstardustBL
4350	INTEGER nbreg_wstardustWAKE
4351	INTEGER, PARAMETER :: nbreg_ssacc = 1
4352	INTEGER, PARAMETER :: nbreg_sscoa = 1
4353	REAL, PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours
4354	REAL scale_param_ind(nbreg_ind)
4355	REAL scale_param_bb(nbreg_bb)
4356	REAL scale_param_ff(nbreg_ff)
4357	REAL scale_param_dustacc(nbreg_dustacc)
4358	REAL scale_param_dustcoa(nbreg_dustcoa)
4359	REAL scale_param_dustsco(nbreg_dustsco)
4360	REAL param_wstarBLperregion(nbreg_wstardustBL)
4361	REAL param_wstarWAKEperregion(nbreg_wstardustWAKE)
4362	REAL scale_param_ssacc
4363	REAL scale_param_ssacc_tmp(nbreg_ssacc)
4364	REAL scale_param_sscoa
4365	REAL scale_param_sscoa_tmp(nbreg_sscoa)
4366
4367	INTEGER k, step_sca, test_sca
4368	REAL :: jH_phys, pdtphys
4369	REAL, SAVE :: jH_sca, jH_ini
4370	INTEGER julien
4371	LOGICAL debutphy
4372	SAVE step_sca, test_sca, iday
4373	!$OMP THREADPRIVATE(step_sca,test_sca,iday)
4374	!$OMP THREADPRIVATE(jH_sca,jH_ini)
4375
4376	IF (debutphy) THEN
4377	iday = julien
4378	step_sca = 1
4379	test_sca = 0
4380	jH_ini = jH_phys
4381	jH_sca = jH_phys
4382	ENDIF
4383
4384	IF (test_sca == 0) THEN
4385	! READ file!!
4386	call read_scalenc(filescaleparams, paramname_ind, &
4387	nbreg_ind, step_sca, &
4388	scale_param_ind)
4389	call read_scalenc(filescaleparams, paramname_bb, &
4390	nbreg_bb, step_sca, &
4391	scale_param_bb)
4392	call read_scalenc(filescaleparams, paramname_ff, &
4393	nbreg_ff, step_sca, &
4394	scale_param_ff)
4395	call read_scalenc(filescaleparams, paramname_dustacc, &
4396	nbreg_dustacc, step_sca, &
4397	scale_param_dustacc)
4398	call read_scalenc(filescaleparams, paramname_dustcoa, &
4399	nbreg_dustcoa, step_sca, &
4400	scale_param_dustcoa)
4401	call read_scalenc(filescaleparams, paramname_dustsco, &
4402	nbreg_dustsco, step_sca, &
4403	scale_param_dustsco)
4404	call read_scalenc(filescaleparams, paramname_wstarBL, &
4405	nbreg_wstardustBL, step_sca, &
4406	param_wstarBLperregion)
4407	call read_scalenc(filescaleparams, paramname_wstarWAKE, &
4408	nbreg_wstardustWAKE, step_sca, &
4409	param_wstarWAKEperregion)
4410	call read_scalenc(filescaleparams, paramname_ssacc, &
4411	nbreg_ssacc, step_sca, &
4412	scale_param_ssacc_tmp)
4413	call read_scalenc(filescaleparams, paramname_sscoa, &
4414	nbreg_sscoa, step_sca, &
4415	scale_param_sscoa_tmp)
4416	scale_param_ssacc = scale_param_ssacc_tmp(1)
4417	scale_param_sscoa = scale_param_sscoa_tmp(1)
4418
4419	!print *,'JEREADFILE',julien,jH_phys
4420	step_sca = step_sca + 1
4421	test_sca = 1
4422	ENDIF
4423
4424	jH_sca = jH_sca + pdtphys / (24. * 3600.)
4425	IF (jH_sca>(sca_resol) / 24.) THEN
4426	test_sca = 0
4427	jH_sca = jH_ini
4428	ENDIF
4429
4430	END SUBROUTINE readscaleparamsnc_spl
4431
4432	SUBROUTINE read_scalenc(filescaleparams, paramname, nbreg, step_sca, &
4433	scale_param)
4434
4435	USE mod_grid_phy_lmdz
4436	USE mod_phys_lmdz_para
4437	USE netcdf, ONLY : nf90_open, nf90_close, nf90_inq_varid, nf90_nowrite, nf90_noerr, nf90_get_var
4438	IMPLICIT NONE
4439
4440	CHARACTER*800 filescaleparams
4441	CHARACTER*100 paramname
4442	INTEGER nbreg, step_sca
4443	REAL scale_param(nbreg)
4444	!local vars
4445	integer nid, ierr, nvarid
4446	real rcode, auxreal
4447	integer start(4), count(4), status
4448	! local
4449	CHARACTER*104 varname
4450	CHARACTER*2 aux_2s
4451	integer i, j, ig
4452	!$OMP MASTER
4453	IF (is_mpi_root .AND. is_omp_root) THEN
4454	ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
4455	if (ierr == nf90_noerr) THEN
4456	do i = 1, nbreg
4457	WRITE(aux_2s, '(i2.2)') i
4458	varname = trim(adjustl(paramname)) // aux_2s
4459	print *, varname
4460	ierr = nf90_inq_varid(nid, trim(adjustl(varname)), nvarid)
4461	ierr = nf90_get_var(nid, nvarid, auxreal, [step_sca])
4462	IF (ierr /= nf90_noerr) THEN
4463	PRINT*, 'Pb de lecture pour modvalues'
4464	print *, 'JE scale_var, step_sca', trim(adjustl(varname)), step_sca
4465	CALL HANDLE_ERR(ierr)
4466	print *, 'error ierr= ', ierr
4467	CALL exit(1)
4468	call abort_gcm('read_scalenc', 'error reading variable', 1)
4469	ENDIF
4470
4471	print *, auxreal
4472	scale_param(i) = auxreal
4473	enddo
4474
4475	ierr = nf90_close(nid)
4476	else
4477	print *, 'File ' // trim(adjustl(filescaleparams)) // ' not found'
4478	print *, 'doing nothing...'
4479	endif
4480
4481	ENDIF ! mpi_root
4482	!$OMP END MASTER
4483	!$OMP BARRIER
4484	! CALL scatter(var local _glo,var local) o algo asi
4485	call bcast(scale_param)
4486	END SUBROUTINE read_scalenc
4487
4488
4489	END MODULE

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format