Context Navigation

phytracr_spl_mod.F90 @ 5117

Last change on this file since 5117 was 5117, checked in by abarral, 3 months ago
rename modules properly lmdz_* move some unused files to obsolete/ (lint) uppercase fortran keywords
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
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 lmdz_grid_phy
786	USE lmdz_phys_para
787	USE IOIPSL
788	USE dimphy
789	USE infotrac
790	USE indice_sol_mod
791	USE lmdz_write_field_phy
792
793	USE lmdz_phys_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	! AS: initialisation des indices par point de grille physique iregion_*
1817	! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
1818	iregion_dust(:) = 1
1819	iregion_ind(:) = 1
1820	iregion_bb(:) = 1
1821	iregion_wstardust(:) = 1
1822
1823	!AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
1824	IF("ASSIM"=="YES") THEN
1825	c_FullName1 = 'regions_dustacc'
1826	!c_FullName1='regions_dust'
1827	CALL readregions_spl(iregion_dust, c_FullName1)
1828	c_FullName1 = 'regions_ind'
1829	CALL readregions_spl(iregion_ind, c_FullName1)
1830	c_FullName1 = 'regions_bb'
1831	CALL readregions_spl(iregion_bb, c_FullName1)
1832	c_FullName1 = 'regions_pwstarwake'
1833	CALL readregions_spl(iregion_wstardust, c_FullName1)
1834
1835	!$OMP MASTER
1836	IF (is_mpi_root .AND. is_omp_root) THEN
1837
1838	OPEN(25, FILE = 'dustregions_pyvar_je.data')
1839	OPEN(55, FILE = 'indregions_pyvar_je.data')
1840	OPEN(75, FILE = 'bbregions_pyvar_je.data')
1841	OPEN(95, FILE = 'wstardustregions_pyvar_je.data')
1842	OPEN(76, FILE = 'xlat.data')
1843	OPEN(77, FILE = 'xlon.data')
1844	ENDIF ! mpi root
1845	!$OMP END MASTER
1846	!$OMP BARRIER
1847
1848	CALL gather(iregion_dust, iauxklon_glo)
1849	!$OMP MASTER
1850	IF (is_mpi_root .AND. is_omp_root) THEN
1851	DO k = 1, klon_glo
1852	WRITE(25, '(i10)') iauxklon_glo(k)
1853	ENDDO
1854	ENDIF ! mpi root
1855	!$OMP END MASTER
1856	!$OMP BARRIER
1857	CALL gather(iregion_ind, iauxklon_glo)
1858	!$OMP MASTER
1859	IF (is_mpi_root .AND. is_omp_root) THEN
1860	DO k = 1, klon_glo
1861	WRITE(55, '(i10)') iauxklon_glo(k)
1862	ENDDO
1863	ENDIF ! mpi root
1864	!$OMP END MASTER
1865	!$OMP BARRIER
1866	CALL gather(iregion_bb, iauxklon_glo)
1867	!$OMP MASTER
1868	IF (is_mpi_root .AND. is_omp_root) THEN
1869	DO k = 1, klon_glo
1870	WRITE(75, '(i10)') iauxklon_glo(k)
1871	ENDDO
1872	ENDIF ! mpi root
1873	!$OMP END MASTER
1874	!$OMP BARRIER
1875	CALL gather(iregion_wstardust, iauxklon_glo)
1876	!$OMP MASTER
1877	IF (is_mpi_root .AND. is_omp_root) THEN
1878	DO k = 1, klon_glo
1879	WRITE(95, '(i10)') iauxklon_glo(k)
1880	ENDDO
1881	ENDIF ! mpi root
1882	!$OMP END MASTER
1883	!$OMP BARRIER
1884
1885	CALL gather(rlat, auxklon_glo)
1886	!$OMP MASTER
1887	IF (is_mpi_root .AND. is_omp_root) THEN
1888	DO k = 1, klon_glo
1889	WRITE(76, *) auxklon_glo(k)
1890	ENDDO
1891	ENDIF ! mpi root
1892	!$OMP END MASTER
1893	!$OMP BARRIER
1894	CALL gather(rlon, auxklon_glo)
1895	!$OMP MASTER
1896	IF (is_mpi_root .AND. is_omp_root) THEN
1897	DO k = 1, klon_glo
1898	WRITE(77, *) auxklon_glo(k)
1899	ENDDO
1900
1901	CLOSE(25)
1902	CLOSE(55)
1903	CLOSE(75)
1904	CLOSE(76)
1905	CLOSE(77)
1906	CLOSE(95)
1907
1908	ENDIF ! mpi root
1909	!$OMP END MASTER
1910	!$OMP BARRIER
1911
1912	ENDIF ! ASSIM
1913
1914	ENDIF ! debutphy
1915
1916	IF (logitime) THEN
1917	CALL SYSTEM_CLOCK(COUNT = clock_end)
1918	dife = clock_end - clock_start
1919	ti_inittype = dife * MAX(0, SIGN(1, dife)) &
1920	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
1921	tia_inittype = tia_inittype + REAL(ti_inittype) / REAL(clock_rate)
1922	ENDIF
1923
1924	IF (logitime) THEN
1925	CALL SYSTEM_CLOCK(COUNT = clock_start)
1926	ENDIF
1927
1928	!=======================================================================
1929	! SAVING SURFACE TYPE
1930	!=======================================================================
1931	IF (debutphy) THEN
1932	!$OMP MASTER
1933	IF (is_mpi_root .AND. is_omp_root) THEN
1934
1935	OPEN(35, FILE = 'surface_ocean.data')
1936	OPEN(45, FILE = 'surface_seaice.data')
1937	OPEN(65, FILE = 'surface_land.data')
1938	OPEN(85, FILE = 'surface_landice.data')
1939	ENDIF ! mpi root
1940	!$OMP END MASTER
1941	!$OMP BARRIER
1942	do i = 1, klon
1943	aux_var2(i) = pctsrf(i, is_oce)
1944	enddo
1945	CALL gather(aux_var2, auxklon_glo)
1946	!$OMP MASTER
1947	IF (is_mpi_root .AND. is_omp_root) THEN
1948	DO i = 1, klon_glo
1949	WRITE (35, 103) auxklon_glo(i)
1950	ENDDO
1951	ENDIF ! mpi root
1952	!$OMP END MASTER
1953	!$OMP BARRIER
1954
1955	do i = 1, klon
1956	aux_var2(i) = pctsrf(i, is_sic)
1957	enddo
1958	CALL gather(aux_var2, auxklon_glo)
1959	!$OMP MASTER
1960	IF (is_mpi_root .AND. is_omp_root) THEN
1961	DO i = 1, klon_glo
1962	WRITE (45, 103) auxklon_glo(i)
1963	ENDDO
1964	ENDIF ! mpi root
1965	!$OMP END MASTER
1966	!$OMP BARRIER
1967
1968	do i = 1, klon
1969	aux_var2(i) = pctsrf(i, is_ter)
1970	enddo
1971	CALL gather(aux_var2, auxklon_glo)
1972	!$OMP MASTER
1973	IF (is_mpi_root .AND. is_omp_root) THEN
1974	DO i = 1, klon_glo
1975	WRITE (65, 103) auxklon_glo(i)
1976	ENDDO
1977	ENDIF ! mpi root
1978	!$OMP END MASTER
1979	!$OMP BARRIER
1980
1981	do i = 1, klon
1982	aux_var2(i) = pctsrf(i, is_lic)
1983	enddo
1984	CALL gather(aux_var2, auxklon_glo)
1985	!$OMP MASTER
1986	IF (is_mpi_root .AND. is_omp_root) THEN
1987	DO i = 1, klon_glo
1988	WRITE (85, 103) auxklon_glo(i)
1989	ENDDO
1990
1991	! DO i = 1, klon
1992	! WRITE (35,103) pctsrf(i,is_oce)
1993	! WRITE (45,103) pctsrf(i,is_sic)
1994	! WRITE (65,103) pctsrf(i,is_ter)
1995	! WRITE (85,103) pctsrf(i,is_lic)
1996	! ENDDO
1997	CLOSE(35)
1998	CLOSE(45)
1999	CLOSE(65)
2000	CLOSE(85)
2001	103 FORMAT (f6.2)
2002	ENDIF ! mpi root
2003	!$OMP END MASTER
2004	!$OMP BARRIER
2005	ENDIF ! debutphy
2006
2007	! stop
2008
2009	!=======================================================================
2010
2011	DO itr = 1, nbtr
2012	DO j = 1, klev
2013	DO i = 1, klon
2014	tmp_var(i, j) = tr_seri(i, j, itr)
2015	ENDDO
2016	ENDDO
2017	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2018	DO j = 1, klev
2019	DO i = 1, klon
2020	tr_seri(i, j, itr) = tmp_var(i, j)
2021	ENDDO
2022	ENDDO
2023	ENDDO
2024	iscm3 = .TRUE.
2025
2026	!=======================================================================
2027
2028	DO k = 1, klev
2029	DO i = 1, klon
2030	m_conc(i, k) = pplay(i, k) / t_seri(i, k) / RKBOL * 1.e-6
2031	ENDDO
2032	ENDDO
2033
2034	IF (lminmax) THEN
2035	DO itr = 1, nbtr
2036	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_avt_coarem')
2037	ENDDO
2038	DO itr = 1, nbtr
2039	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'avt coarem')
2040	ENDDO
2041	CALL minmaxsource(source_tr, qmin, qmax, 'src: avt coarem')
2042	ENDIF
2043
2044	IF (logitime) THEN
2045	CALL SYSTEM_CLOCK(COUNT = clock_end)
2046	dife = clock_end - clock_start
2047	ti_inittwrite = dife * MAX(0, SIGN(1, dife)) &
2048	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2049	tia_inittwrite = tia_inittwrite + REAL(ti_inittwrite) / REAL(clock_rate)
2050	ENDIF
2051
2052
2053	!=======================================================================
2054	! EMISSIONS OF COARSE AEROSOLS
2055	!=======================================================================
2056
2057	IF (logitime) THEN
2058	CALL SYSTEM_CLOCK(COUNT = clock_start)
2059	ENDIF
2060
2061	print *, 'Number of tracers = ', nbtr
2062
2063	print *, 'AT BEGINNING OF PHYTRACR_SPL'
2064	! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
2065	! . MAXVAL(tr_seri(:,:,3))
2066	#ifdef IOPHYS_DUST
2067	do itr=1,nbtr
2068	WRITE(str2,'(i2.2)') itr
2069	CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
2070	CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
2071	enddo
2072	do itr=1,nbtr
2073	WRITE(str2,'(i2.2)') itr
2074	CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2075	enddo
2076	#endif
2077
2078
2079	CALL coarsemission(pctsrf, pdtphys, t_seri, &
2080	pmflxr, pmflxs, prfl, psfl, &
2081	rlat, rlon, debutphy, &
2082	zu10m, zv10m, wstar, ale_bl, ale_wake, &
2083	scale_param_ssacc, scale_param_sscoa, &
2084	scale_param_dustacc, scale_param_dustcoa, &
2085	scale_param_dustsco, &
2086	nbreg_dust, &
2087	iregion_dust, dust_ec, &
2088	param_wstarBLperregion, param_wstarWAKEperregion, &
2089	nbreg_wstardust, &
2090	iregion_wstardust, &
2091	lmt_sea_salt, qmin, qmax, &
2092	flux_sparam_ddfine, flux_sparam_ddcoa, &
2093	flux_sparam_ddsco, &
2094	flux_sparam_ssfine, flux_sparam_sscoa, &
2095	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2096	ok_chimeredust, &
2097	source_tr, flux_tr)
2098
2099	#ifdef IOPHYS_DUST
2100	do itr=1,nbtr
2101	WRITE(str2,'(i2.2)') itr
2102	CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
2103	CALL iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,itr))
2104	enddo
2105	#endif
2106
2107	IF (lminmax) THEN
2108	DO itr = 1, nbtr
2109	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_coarem')
2110	ENDDO
2111	DO itr = 1, nbtr
2112	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after coarem')
2113	ENDDO
2114	CALL minmaxsource(source_tr, qmin, qmax, 'src: after coarem')
2115	ENDIF
2116
2117
2118
2119	!======================================================================
2120	! EMISSIONS OF AEROSOL PRECURSORS
2121	!======================================================================
2122
2123	#ifdef IOPHYS_DUST
2124	print *,'INPUT TO PRECUREMISSION'
2125	CALL iophys_ecrit('ftsol',4,'ftsol','',ftsol)
2126	CALL iophys_ecrit('u10m_ec',1,'u10m_ec','',u10m_ec)
2127	CALL iophys_ecrit('v10m_ec',1,'v10m_ec','',v10m_ec)
2128	CALL iophys_ecrit('pctsrf',4,'pctsrf','',pctsrf)
2129	CALL iophys_ecrit('u_seri',klev,'u_seri','',u_seri)
2130	CALL iophys_ecrit('v_seri',klev,'v_seri','',v_seri)
2131	CALL iophys_ecrit('paprs',klev,'paprs','',paprs)
2132	CALL iophys_ecrit('pplay',klev,'pplay','',pplay)
2133	CALL iophys_ecrit('cdragh',1,'cdragh','',cdragh)
2134	CALL iophys_ecrit('cdragm',1,'cdragm','',cdragm)
2135	CALL iophys_ecrit('t_seri',klev,'t_seri','',t_seri)
2136	CALL iophys_ecrit('q_seri',klev,'q_seri','',q_seri)
2137	CALL iophys_ecrit('tsol',1,'tsol','',tsol)
2138	PRINT*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau
2139	PRINT*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys
2140	PRINT*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind
2141	PRINT*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb
2142	PRINT*,'id_prec,id_fine',id_prec,id_fine
2143	CALL iophys_ecrit('zdz',klev,'zdz','',zdz)
2144	CALL iophys_ecrit('zalt',klev,'zalt','',zalt)
2145	CALL iophys_ecrit('lmt_so2ff_l',1,'lmt_so2ff_l','',lmt_so2ff_l)
2146	CALL iophys_ecrit('lmt_so2ff_h',1,'lmt_so2ff_h','',lmt_so2ff_h)
2147	CALL iophys_ecrit('lmt_so2nff',1,'lmt_so2nff','',lmt_so2nff)
2148	CALL iophys_ecrit('lmt_so2ba',1,'lmt_so2ba','',lmt_so2ba)
2149	CALL iophys_ecrit('lmt_so2bb_l',1,'lmt_so2bb_l','',lmt_so2bb_l)
2150	CALL iophys_ecrit('lmt_so2bb_h',1,'lmt_so2bb_h','',lmt_so2bb_h)
2151	CALL iophys_ecrit('lmt_so2volc_cont',1,'lmt_so2volc_cont','',lmt_so2volc_cont)
2152	CALL iophys_ecrit('lmt_altvolc_cont',1,'lmt_altvolc_cont','',lmt_altvolc_cont)
2153	CALL iophys_ecrit('lmt_so2volc_expl',1,'lmt_so2volc_expl','',lmt_so2volc_expl)
2154	CALL iophys_ecrit('lmt_altvolc_expl',1,'lmt_altvolc_expl','',lmt_altvolc_expl)
2155	CALL iophys_ecrit('lmt_dmsbio',1,'lmt_dmsbio','',lmt_dmsbio)
2156	CALL iophys_ecrit('lmt_h2sbio',1,'lmt_h2sbio','',lmt_h2sbio)
2157	CALL iophys_ecrit('lmt_dmsconc',1,'lmt_dmsconc','',lmt_dmsconc)
2158	CALL iophys_ecrit('lmt_dms',1,'lmt_dms','',lmt_dms)
2159	CALL iophys_ecrit('flux_sparam_ind',1,'flux_sparam_ind','',flux_sparam_ind)
2160	CALL iophys_ecrit('flux_sparam_bb',1,'flux_sparam_bb','',flux_sparam_bb)
2161	#endif
2162
2163
2164
2165	PRINT*, 'ON PASSE DANS precuremission'
2166	CALL precuremission(ftsol, u10m_ec, v10m_ec, pctsrf, &
2167	u_seri, v_seri, paprs, pplay, cdragh, cdragm, &
2168	t_seri, q_seri, tsol, fracso2emis, frach2sofso2, &
2169	bateau, zdz, zalt, kminbc, kmaxbc, pdtphys, &
2170	scale_param_bb, scale_param_ind, &
2171	iregion_ind, iregion_bb, &
2172	nbreg_ind, nbreg_bb, &
2173	lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, lmt_so2ba, &
2174	lmt_so2bb_l, lmt_so2bb_h, &
2175	lmt_so2volc_cont, lmt_altvolc_cont, &
2176	lmt_so2volc_expl, lmt_altvolc_expl, &
2177	lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, lmt_dms, &
2178	id_prec, id_fine, &
2179	flux_sparam_ind, flux_sparam_bb, &
2180	source_tr, flux_tr, tr_seri)
2181
2182	IF (lminmax) THEN
2183	DO itr = 1, nbtr
2184	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after precur')
2185	ENDDO
2186	DO itr = 1, nbtr
2187	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after precur')
2188	ENDDO
2189	CALL minmaxsource(source_tr, qmin, qmax, 'src: after precur')
2190	ENDIF
2191
2192	!=======================================================================
2193	! EMISSIONS OF FINE AEROSOLS
2194	!=======================================================================
2195	#ifdef IOPHYS_DUST
2196
2197	do itr=1,nbtr
2198	WRITE(str2,'(i2.2)') itr
2199	CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
2200	CALL iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,itr))
2201	enddo
2202	#endif
2203
2204	CALL finemission(zdz, pdtphys, zalt, kminbc, kmaxbc, &
2205	scale_param_bb, scale_param_ff, &
2206	iregion_ind, iregion_bb, &
2207	nbreg_ind, nbreg_bb, &
2208	lmt_bcff, lmt_bcnff, lmt_bcbb_l, lmt_bcbb_h, &
2209	lmt_bcba, lmt_omff, lmt_omnff, &
2210	lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, &
2211	id_fine, &
2212	flux_sparam_bb, flux_sparam_ff, &
2213	source_tr, flux_tr, tr_seri)
2214
2215	IF (lminmax) THEN
2216	DO itr = 1, nbtr
2217	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_fineem')
2218	ENDDO
2219	DO itr = 1, nbtr
2220	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after fineem')
2221	ENDDO
2222	IF (lcheckmass) THEN
2223	DO itr = 1, nbtr
2224	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2225	pplay, t_seri, iscm3, 'after fineem')
2226	ENDDO
2227	ENDIF
2228	CALL minmaxsource(source_tr, qmin, qmax, 'src: after fineem')
2229	ENDIF
2230
2231	IF (logitime) THEN
2232	CALL SYSTEM_CLOCK(COUNT = clock_end)
2233	dife = clock_end - clock_start
2234	ti_emis = dife * MAX(0, SIGN(1, dife)) &
2235	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2236	tia_emis = tia_emis + REAL(ti_emis) / REAL(clock_rate)
2237	ENDIF
2238
2239
2240	#ifdef IOPHYS_DUST
2241	do itr=1,nbtr
2242	WRITE(str2,'(i2.2)') itr
2243	CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
2244	CALL iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,itr))
2245	enddo
2246	#endif
2247
2248
2249	!=======================================================================
2250	! DRY DEPOSITION AND BOUNDARY LAYER MIXING
2251	!=======================================================================
2252
2253	! DO itr=1,nbtr
2254	! CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,
2255	! . pplay,t_seri,iscm3,'')
2256	! ENDDO
2257
2258	!======================================================================
2259	! -- Dry deposition --
2260	!======================================================================
2261	IF (logitime) THEN
2262	CALL SYSTEM_CLOCK(COUNT = clock_start)
2263	ENDIF
2264
2265	DO itr = 1, nbtr
2266	DO j = 1, klev
2267	DO i = 1, klon
2268	tmp_var(i, j) = tr_seri(i, j, itr)
2269	ENDDO
2270	ENDDO
2271	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2272	DO j = 1, klev
2273	DO i = 1, klon
2274	tr_seri(i, j, itr) = tmp_var(i, j)
2275	ENDDO
2276	ENDDO
2277	ENDDO
2278	iscm3 = .FALSE.
2279	!----------------------------
2280	IF (lminmax) THEN
2281	DO itr = 1, nbtr
2282	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_depo')
2283	ENDDO
2284	DO itr = 1, nbtr
2285	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before depo')
2286	ENDDO
2287	IF (lcheckmass) THEN
2288	DO itr = 1, nbtr
2289	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2290	pplay, t_seri, iscm3, 'before depo')
2291	ENDDO
2292	ENDIF
2293	CALL minmaxsource(source_tr, qmin, qmax, 'src: before depo')
2294	ENDIF
2295
2296	#ifdef IOPHYS_DUST
2297	do itr=1,nbtr
2298	WRITE(str2,'(i2.2)') itr
2299	CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2300	enddo
2301	#endif
2302
2303	CALL deposition(vdep_oce, vdep_sic, vdep_ter, vdep_lic, pctsrf, &
2304	zrho, zdz, pdtphys, RHcl, masse, t_seri, pplay, paprs, &
2305	lminmax, qmin, qmax, &
2306	his_ds, source_tr, tr_seri)
2307
2308	IF (lminmax) THEN
2309	DO itr = 1, nbtr
2310	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_depo')
2311	ENDDO
2312	DO itr = 1, nbtr
2313	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after depo')
2314	ENDDO
2315	IF (lcheckmass) THEN
2316	DO itr = 1, nbtr
2317	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2318	pplay, t_seri, iscm3, 'after depo')
2319	ENDDO
2320	ENDIF
2321	CALL minmaxsource(source_tr, qmin, qmax, 'src: after depo')
2322	ENDIF
2323
2324	IF (logitime) THEN
2325	CALL SYSTEM_CLOCK(COUNT = clock_end)
2326	dife = clock_end - clock_start
2327	ti_depo = dife * MAX(0, SIGN(1, dife)) &
2328	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2329	tia_depo = tia_depo + REAL(ti_depo) / REAL(clock_rate)
2330	ENDIF
2331
2332	!======================================================================
2333	! -- Boundary layer mixing --
2334	!======================================================================
2335
2336	#ifdef IOPHYS_DUST
2337	do itr=1,nbtr
2338	WRITE(str2,'(i2.2)') itr
2339	CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2340	enddo
2341	#endif
2342
2343
2344
2345	IF (logitime) THEN
2346	CALL SYSTEM_CLOCK(COUNT = clock_start)
2347	ENDIF
2348
2349	DO k = 1, klev
2350	DO i = 1, klon
2351	delp(i, k) = paprs(i, k) - paprs(i, k + 1)
2352	END DO
2353	END DO
2354
2355	DO itr = 1, nbtr
2356	DO j = 1, klev
2357	DO i = 1, klon
2358	tmp_var(i, j) = tr_seri(i, j, itr)
2359	aux_var2(i) = source_tr(i, itr)
2360	ENDDO
2361	ENDDO
2362	IF (iflag_conv==2) THEN
2363	! Tiedke
2364	CALL cltrac_spl(pdtphys, coefh, yu1, yv1, t_seri, tmp_var, &
2365	aux_var2, paprs, pplay, aux_var3)
2366
2367	ELSE IF (iflag_conv>=3) THEN
2368	!KE
2369	CALL cltrac(pdtphys, coefh, t_seri, tmp_var, aux_var2, paprs, pplay, &
2370	delp, aux_var3, d_tr_dry, flux_tr_dry(:, itr))
2371	ENDIF
2372
2373	DO i = 1, klon
2374	DO j = 1, klev
2375	tr_seri(i, j, itr) = tmp_var(i, j)
2376	d_tr(i, j, itr) = aux_var3(i, j)
2377	d_tr_cl(i, j, itr) = d_tr(i, j, itr)
2378	ENDDO
2379	ENDDO
2380	DO k = 1, klev
2381	DO i = 1, klon
2382	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr(i, k, itr)
2383	ENDDO
2384	ENDDO
2385	print *, ' AFTER Cltrac'
2386	IF (lminmax) THEN
2387	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after cltrac')
2388	ENDIF
2389	ENDDO !--end itr loop
2390
2391	IF (logitime) THEN
2392	CALL SYSTEM_CLOCK(COUNT = clock_end)
2393	dife = clock_end - clock_start
2394	ti_cltr = dife * MAX(0, SIGN(1, dife)) &
2395	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2396	tia_cltr = tia_cltr + REAL(ti_cltr) / REAL(clock_rate)
2397	ENDIF
2398
2399
2400
2401	!======================================================================
2402	! -- Calcul de l'effet des thermiques for KE--
2403	!======================================================================
2404
2405	#ifdef IOPHYS_DUST
2406	PRINT*,'iflag_conv=',iflag_conv
2407	CALL iophys_ecrit('coefh',klev,'coefh','',coefh)
2408	CALL iophys_ecrit('yu1',1,'yu1','',yu1)
2409	CALL iophys_ecrit('yv1',1,'yv1','',yv1)
2410	CALL iophys_ecrit('delp',klev,'delp','',delp)
2411	do itr=1,nbtr
2412	WRITE(str2,'(i2.2)') itr
2413	CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2414	enddo
2415	#endif
2416
2417
2418
2419	IF (iflag_conv>=3) THEN
2420
2421	IF (logitime) THEN
2422	CALL SYSTEM_CLOCK(COUNT = clock_start)
2423	ENDIF
2424
2425	IF (lminmax) THEN
2426	DO itr = 1, nbtr
2427	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before therm')
2428	ENDDO
2429	DO itr = 1, nbtr
2430	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before therm')
2431	ENDDO
2432	IF (lcheckmass) THEN
2433	DO itr = 1, nbtr
2434	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2435	pplay, t_seri, iscm3, 'before therm')
2436	ENDDO
2437	ENDIF
2438	CALL minmaxsource(source_tr, qmin, qmax, 'before therm')
2439	ENDIF
2440
2441	DO itr = 1, nbtr
2442	DO k = 1, klev
2443	DO i = 1, klon
2444	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2445	d_tr_th(i, k, itr) = 0.
2446	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr), 0.)
2447	!JE: precursor >>1e10 tr_seri(i,k,itr)=MIN(tr_seri(i,k,itr),1.e10)
2448	END DO
2449	END DO
2450	END DO
2451
2452	!JE new implicit scheme 20140323
2453	DO itr = 1, nbtr
2454	CALL thermcell_dq(klon, klev, 1, pdtphys, fm_therm, entr_therm, &
2455	zmasse, tr_seri(1:klon, 1:klev, itr), &
2456	d_tr(1:klon, 1:klev, itr), ztra_th, 0)
2457
2458	DO k = 1, klev
2459	DO i = 1, klon
2460	d_tr(i, k, itr) = pdtphys * d_tr(i, k, itr)
2461	d_tr_th(i, k, itr) = d_tr_th(i, k, itr) + d_tr(i, k, itr)
2462	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr) + d_tr(i, k, itr), 0.)
2463	END DO
2464	END DO
2465
2466	ENDDO
2467
2468	! old scheme explicit
2469	! nsplit=10
2470	! DO itr=1,nbtr
2471	! DO isplit=1,nsplit
2472	! CALL dqthermcell(klon,klev,pdtphys/nsplit,
2473	! . fm_therm,entr_therm,zmasse,
2474	! . tr_seri(1:klon,1:klev,itr),
2475	! . d_tr(1:klon,1:klev,itr),ztra_th)
2476	! DO k=1,klev
2477	! DO i=1,klon
2478	! d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)/nsplit
2479	! d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
2480	! tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
2481	! END DO
2482	! END DO
2483	! END DO ! nsplit1
2484	! END DO ! it
2485	!JE end modif 20140323
2486
2487	DO itr = 1, nbtr
2488	DO k = 1, klev
2489	DO i = 1, klon
2490	tmp_var(i, k) = tr_seri(i, k, itr) - tmp_var3(i, k, itr)
2491	ENDDO
2492	ENDDO
2493	IF (lminmax) THEN
2494	IF (lcheckmass) THEN
2495	CALL checkmass(tmp_var(:, :), RNAVO, masse(itr), zdz, &
2496	pplay, t_seri, iscm3, 'dtr therm ')
2497	ENDIF
2498	ENDIF
2499	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2500
2501	DO k = 1, klev
2502	DO i = 1, klon
2503	his_th(i, itr) = his_th(i, itr) + &
2504	(tmp_var(i, k)) / RNAVO * &
2505	masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2506	END DO !klon
2507	END DO !klev
2508
2509	END DO !it
2510	IF (lminmax) THEN
2511	DO itr = 1, nbtr
2512	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after therm')
2513	ENDDO
2514	DO itr = 1, nbtr
2515	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after therm')
2516	ENDDO
2517	IF (lcheckmass) THEN
2518	DO itr = 1, nbtr
2519	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2520	pplay, t_seri, iscm3, 'after therm')
2521	ENDDO
2522	ENDIF
2523	CALL minmaxsource(source_tr, qmin, qmax, 'after therm')
2524	ENDIF
2525
2526	IF (logitime) THEN
2527	CALL SYSTEM_CLOCK(COUNT = clock_end)
2528	dife = clock_end - clock_start
2529	ti_ther = dife * MAX(0, SIGN(1, dife)) &
2530	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2531	tia_ther = tia_ther + REAL(ti_ther) / REAL(clock_rate)
2532	ENDIF
2533
2534	ENDIF ! iflag_conv KE
2535	!------------------------------------
2536	! Sedimentation
2537	!-----------------------------------
2538	IF (logitime) THEN
2539	CALL SYSTEM_CLOCK(COUNT = clock_start)
2540	ENDIF
2541
2542	DO itr = 1, nbtr
2543	DO j = 1, klev
2544	DO i = 1, klon
2545	tmp_var(i, j) = tr_seri(i, j, itr)
2546	ENDDO
2547	ENDDO
2548	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2549	DO j = 1, klev
2550	DO i = 1, klon
2551	tr_seri(i, j, itr) = tmp_var(i, j)
2552	ENDDO
2553	ENDDO
2554	ENDDO !--end itr loop
2555	iscm3 = .TRUE.
2556	!--------------------------------------
2557	print *, ' BEFORE Sediment'
2558
2559	IF (lminmax) THEN
2560	DO itr = 1, nbtr
2561	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_sedi')
2562	ENDDO
2563	DO itr = 1, nbtr
2564	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before sedi')
2565	ENDDO
2566	IF (lcheckmass) THEN
2567	DO itr = 1, nbtr
2568	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2569	pplay, t_seri, iscm3, 'before sedi')
2570	ENDDO
2571	ENDIF
2572	CALL minmaxsource(source_tr, qmin, qmax, 'src: before sedi')
2573	ENDIF
2574
2575	print *, 'SPLA VERSION OF SEDIMENTATION IS USED'
2576	CALL sediment_mod(t_seri, pplay, zrho, paprs, pdtphys, RHcl, &
2577	id_coss, id_codu, id_scdu, &
2578	ok_chimeredust, &
2579	sed_ss, sed_dust, sed_dustsco, &
2580	sed_ss3D, sed_dust3D, sed_dustsco3D, tr_seri)
2581	CALL cm3_to_kg(pplay, t_seri, sed_ss3D)
2582	CALL cm3_to_kg(pplay, t_seri, sed_dust3D)
2583	CALL cm3_to_kg(pplay, t_seri, sed_dustsco3D)
2584
2585	IF (lminmax) THEN
2586	DO itr = 1, nbtr
2587	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_sedi')
2588	ENDDO
2589	DO itr = 1, nbtr
2590	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after sedi')
2591	ENDDO
2592	IF (lcheckmass) THEN
2593	DO itr = 1, nbtr
2594	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2595	pplay, t_seri, iscm3, 'after sedi')
2596	ENDDO
2597	ENDIF
2598	CALL minmaxsource(source_tr, qmin, qmax, 'src: after sedi')
2599	ENDIF
2600
2601	!=======================================================================
2602	#ifdef IOPHYS_DUST
2603	do itr=1,nbtr
2604	WRITE(str2,'(i2.2)') itr
2605	CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2606	enddo
2607	#endif
2608
2609	IF (logitime) THEN
2610	CALL SYSTEM_CLOCK(COUNT = clock_end)
2611	dife = clock_end - clock_start
2612	ti_sedi = dife * MAX(0, SIGN(1, dife)) &
2613	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2614	tia_sedi = tia_sedi + REAL(ti_sedi) / REAL(clock_rate)
2615	ENDIF
2616
2617	DO itr = 1, nbtr
2618	DO j = 1, klev
2619	DO i = 1, klon
2620	tmp_var(i, j) = tr_seri(i, j, itr)
2621	ENDDO
2622	ENDDO
2623	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2624	DO j = 1, klev
2625	DO i = 1, klon
2626	tr_seri(i, j, itr) = tmp_var(i, j)
2627	ENDDO
2628	ENDDO
2629	ENDDO
2630	iscm3 = .FALSE.
2631
2632
2633	!======================================================================
2634	! GAS TO PARTICLE CONVERSION
2635	!======================================================================
2636
2637	IF (logitime) THEN
2638	CALL SYSTEM_CLOCK(COUNT = clock_start)
2639	ENDIF
2640
2641	IF (lminmax) THEN
2642	DO itr = 1, nbtr
2643	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_beforegastopar')
2644	ENDDO
2645	DO itr = 1, nbtr
2646	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before gastopar')
2647	ENDDO
2648	IF (lcheckmass) THEN
2649	DO itr = 1, nbtr
2650	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2651	pplay, t_seri, iscm3, 'before gastopar')
2652	ENDDO
2653	ENDIF
2654	CALL minmaxsource(source_tr, qmin, qmax, 'src: before gastopar')
2655	ENDIF
2656
2657	CALL gastoparticle(pdtphys, zdz, zrho, rlat, &
2658	pplay, t_seri, id_prec, id_fine, &
2659	tr_seri, his_g2pgas, his_g2paer)
2660
2661	IF (lminmax) THEN
2662	DO itr = 1, nbtr
2663	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_gastopar')
2664	ENDDO
2665	DO itr = 1, nbtr
2666	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after gastopar')
2667	ENDDO
2668	IF (lcheckmass) THEN
2669	DO itr = 1, nbtr
2670	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2671	pplay, t_seri, iscm3, 'after gastopar')
2672	ENDDO
2673	ENDIF
2674	CALL minmaxsource(source_tr, qmin, qmax, 'src: after gastopar')
2675	ENDIF
2676
2677	IF (logitime) THEN
2678	CALL SYSTEM_CLOCK(COUNT = clock_end)
2679	dife = clock_end - clock_start
2680	ti_gasp = dife * MAX(0, SIGN(1, dife)) &
2681	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2682	tia_gasp = tia_gasp + REAL(ti_gasp) / REAL(clock_rate)
2683	ENDIF
2684
2685	!======================================================================
2686	! EFFECT OF PRECIPITATION: iflag_conv=2
2687	!======================================================================
2688
2689	#ifdef IOPHYS_DUST
2690	do itr=1,nbtr
2691	WRITE(str2,'(i2.2)') itr
2692	CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2693	enddo
2694	#endif
2695
2696
2697	IF (iflag_conv==2) THEN
2698
2699	IF (logitime) THEN
2700	CALL SYSTEM_CLOCK(COUNT = clock_start)
2701	ENDIF
2702
2703	DO itr = 1, nbtr
2704	DO j = 1, klev
2705	DO i = 1, klon
2706	tmp_var(i, j) = tr_seri(i, j, itr)
2707	ENDDO
2708	ENDDO
2709	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2710	DO j = 1, klev
2711	DO i = 1, klon
2712	tr_seri(i, j, itr) = tmp_var(i, j)
2713	ENDDO
2714	ENDDO
2715	ENDDO
2716	iscm3 = .TRUE.
2717	!------------------------------
2718
2719	print *, 'iflag_conv bef lessiv', iflag_conv
2720	IF (lessivage) THEN
2721
2722	print *, ' BEFORE Incloud'
2723
2724	IF (lminmax) THEN
2725	DO itr = 1, nbtr
2726	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_incloud')
2727	ENDDO
2728	DO itr = 1, nbtr
2729	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before incloud')
2730	ENDDO
2731	IF (lcheckmass) THEN
2732	DO itr = 1, nbtr
2733	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2734	pplay, t_seri, iscm3, 'before incloud')
2735	ENDDO
2736	ENDIF
2737	CALL minmaxsource(source_tr, qmin, qmax, 'src: before incloud')
2738	ENDIF
2739
2740
2741	! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
2742	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2743
2744	! . his_dhlsc,his_dhcon,tr_seri)
2745	print *, 'iflag_conv bef incloud', iflag_conv
2746
2747	IF (iflag_conv==2) THEN
2748	! Tiedke
2749	CALL incloud_scav(.FALSE., qmin, qmax, masse, henry, kk, prfl, &
2750	psfl, pmflxr, pmflxs, zrho, zdz, t_seri, pdtphys, &
2751	his_dhlsc, his_dhcon, tr_seri)
2752
2753	!---------- to use this option please comment lsc_scav at the end
2754	! ELSE IF (iflag_conv.GE.3) THEN
2755
2756	! CALL incloud_scav_lsc(.FALSE.,qmin,qmax,masse,henry,kk,prfl,
2757	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2758	! . his_dhlsc,his_dhcon,tr_seri)
2759	!--------------------------------------------------------------
2760
2761	ENDIF
2762
2763	print *, ' BEFORE blcloud (after incloud)'
2764	IF (lminmax) THEN
2765	DO itr = 1, nbtr
2766	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_blcloud')
2767	ENDDO
2768	DO itr = 1, nbtr
2769	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before blcloud')
2770	ENDDO
2771	IF (lcheckmass) THEN
2772	DO itr = 1, nbtr
2773	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2774	pplay, t_seri, iscm3, 'before blcloud')
2775	ENDDO
2776	ENDIF
2777	CALL minmaxsource(source_tr, qmin, qmax, 'src: before blcloud')
2778	ENDIF
2779
2780	! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
2781	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2782	! . his_dhbclsc,his_dhbccon,tr_seri)
2783
2784	IF (iflag_conv==2) THEN
2785	! Tiedke
2786
2787	CALL blcloud_scav(.FALSE., qmin, qmax, pdtphys, prfl, psfl, &
2788	pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
2789	his_dhbclsc, his_dhbccon, tr_seri)
2790
2791	!---------- to use this option please comment lsc_scav at the end
2792	! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
2793
2794
2795	! ELSE IF (iflag_conv.GE.3) THEN
2796
2797	! CALL blcloud_scav_lsc(.FALSE.,qmin,qmax,pdtphys,prfl,psfl,
2798	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2799	! . his_dhbclsc,his_dhbccon,tr_seri)
2800
2801	!----------------------------------------------------------------------
2802	ENDIF
2803
2804	print *, ' AFTER blcloud '
2805
2806	IF (lminmax) THEN
2807	DO itr = 1, nbtr
2808	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_blcloud')
2809	ENDDO
2810	DO itr = 1, nbtr
2811	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after blcloud')
2812	ENDDO
2813	IF (lcheckmass) THEN
2814	DO itr = 1, nbtr
2815	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2816	pplay, t_seri, iscm3, 'after blcloud')
2817	ENDDO
2818	ENDIF
2819	CALL minmaxsource(source_tr, qmin, qmax, 'src: after blcloud')
2820	ENDIF
2821
2822	ENDIF !--lessivage
2823
2824	DO itr = 1, nbtr
2825	DO j = 1, klev
2826	DO i = 1, klon
2827	tmp_var(i, j) = tr_seri(i, j, itr)
2828	ENDDO
2829	ENDDO
2830	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2831	DO j = 1, klev
2832	DO i = 1, klon
2833	tr_seri(i, j, itr) = tmp_var(i, j)
2834	ENDDO
2835	ENDDO
2836	ENDDO
2837	iscm3 = .FALSE.
2838
2839	IF (logitime) THEN
2840	CALL SYSTEM_CLOCK(COUNT = clock_end)
2841	dife = clock_end - clock_start
2842	ti_wetap = dife * MAX(0, SIGN(1, dife)) &
2843	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2844	tia_wetap = tia_wetap + REAL(ti_wetap) / REAL(clock_rate)
2845	ENDIF
2846
2847	ENDIF ! iflag_conv=2
2848
2849
2850	!======================================================================
2851	! EFFECT OF CONVECTION
2852	!======================================================================
2853
2854	#ifdef IOPHYS_DUST
2855	do itr=1,nbtr
2856	WRITE(str2,'(i2.2)') itr
2857	CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2858	enddo
2859	#endif
2860
2861
2862	IF (logitime) THEN
2863	CALL SYSTEM_CLOCK(COUNT = clock_start)
2864	ENDIF
2865
2866	IF (convection) THEN
2867
2868	print *, ' BEFORE trconvect'
2869
2870	IF (lminmax) THEN
2871	DO itr = 1, nbtr
2872	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_trconve')
2873	ENDDO
2874	DO itr = 1, nbtr
2875	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before trconve')
2876	ENDDO
2877	IF (lcheckmass) THEN
2878	DO itr = 1, nbtr
2879	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2880	pplay, t_seri, iscm3, 'before trconve')
2881	ENDDO
2882	ENDIF
2883	CALL minmaxsource(source_tr, qmin, qmax, 'src: before trconve')
2884	ENDIF
2885
2886
2887	! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
2888	! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
2889	! . dtrconv,tr_seri)
2890	! -------------------------------------------------------------
2891	IF (iflag_conv==2) THEN
2892	! Tiedke
2893	CALL trconvect(pplay, t_seri, pdtphys, pmfu, pmfd, pen_u, pde_u, &
2894	pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .FALSE., masse, &
2895	dtrconv, tr_seri)
2896	DO itr = 1, nbtr
2897	d_tr_cv(:, :, itr) = 0.
2898	ENDDO
2899
2900	ELSE IF (iflag_conv>=3) THEN
2901	! KE
2902	print *, 'JE: KE in phytracr_spl'
2903	DO itr = 1, nbtr
2904	DO k = 1, klev
2905	DO i = 1, klon
2906	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2907	END DO
2908	END DO
2909	ENDDO
2910
2911	DO itr = 1, nbtr
2912	! routine for aerosols . otherwise, check cvltrorig
2913	print *, 'Check sum before cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2914	! IF (.FALSE.) THEN
2915	CALL cvltr_spl(pdtphys, da, phi, phi2, d1a, dam, mp, ep, &
2916	sigd, sij, wght_cvfd, clw, elij, epmlmMm, eplaMm, &
2917	pmflxr, pmflxs, evapls, t_seri, wdtrainA, wdtrainM, &
2918	! paprs,itr,tr_seri,upwd,dnwd,itop_con,ibas_con, &
2919	paprs, itr, tmp_var3, upwd, dnwd, itop_con, ibas_con, &
2920	henry, kk, zrho, ccntrAA_spla, ccntrENV_spla, coefcoli_spla, &
2921	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2922	d_tr_cv, d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, qDi, qPr, &
2923	qPa, qMel, qTrdi, dtrcvMA, Mint, &
2924	zmfd1a, zmfphi2, zmfdam)
2925	! ENDIF
2926
2927	! IF (.FALSE.) THEN
2928	! CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
2929	! . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
2930	! . pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,
2931	! . paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,
2932	! . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
2933	! . qPa,qMel,qTrdi,dtrcvMA,Mint,
2934	! . zmfd1a,zmfphi2,zmfdam)
2935	!! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
2936	! ENDIF
2937
2938
2939
2940	!!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
2941	!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
2942	!!! . upwd,dnwd,d_tr_cv)
2943	! print *,'justbefore cvltrnoscav it= ',it
2944	! CALL checknanqfi(da(:,:),1.,-1.,' da')
2945	! CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ')
2946	! CALL checknanqfi(mp(:,:),1.,-1.,'mp ')
2947	! CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ')
2948	! CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ')
2949	! CALL checknanqfi(tmp_var3(:,:,itr),1.,-1.,'tmp_var3 ')
2950	! CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ')
2951	! CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ')
2952	! CALL checknanqfi(d_tr_cv(:,:,itr),1.,-1.,'d_tr_cv ')
2953	! IF (.TRUE.) THEN
2954	! CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
2955	! . pplay,tmp_var3,upwd,dnwd,d_tr_cv)
2956	! ENDIF
2957	DO k = 1, klev
2958	DO i = 1, klon
2959	! tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr_cv(i,k,itr)
2960	tr_seri(i, k, itr) = (tmp_var3(i, k, itr) + d_tr_cv(i, k, itr))
2961	tmp_var(i, k) = d_tr_cv(i, k, itr)
2962
2963	END DO
2964	END DO
2965
2966	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2967
2968	DO k = 1, klev
2969	DO i = 1, klon
2970	dtrconv(i, itr) = 0.0
2971	his_dhkecv(i, itr) = his_dhkecv(i, itr) - tmp_var(i, k) &
2972	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2973	END DO
2974	END DO
2975
2976	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2977	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2978
2979	DO k = 1, klev
2980	DO i = 1, klon
2981	dtrconv(i, itr) = 0.0
2982	his_ds(i, itr) = his_ds(i, itr) - tmp_var(i, k) &
2983	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2984	END DO
2985	END DO
2986	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2987	IF (lminmax) THEN
2988
2989	print *, 'Check sum after cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2990	CALL minmaxqfi2(d_tr_cv(:, :, itr), qmin, qmax, 'd_tr_cv:')
2991	CALL minmaxqfi2(d_tr_trsp(:, :, itr), qmin, qmax, 'd_tr_trsp:')
2992	CALL minmaxqfi2(d_tr_sscav(:, :, itr), qmin, qmax, 'd_tr_sscav:')
2993	CALL minmaxqfi2(d_tr_sat(:, :, itr), qmin, qmax, 'd_tr_sat:')
2994	CALL minmaxqfi2(d_tr_uscav(:, :, itr), qmin, qmax, 'd_tr_uscav:')
2995	IF (lcheckmass) THEN
2996	CALL checkmass(d_tr_cv(:, :, itr), RNAVO, masse(itr), zdz, &
2997	pplay, t_seri, .FALSE., 'd_tr_cv:')
2998	ENDIF
2999	ENDIF
3000	ENDDO ! it=1,nbtr
3001
3002	ENDIF ! iflag_conv
3003	IF (lminmax) THEN
3004	DO itr = 1, nbtr
3005	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_trcon')
3006	ENDDO
3007	DO itr = 1, nbtr
3008	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after trconv')
3009	ENDDO
3010	IF (lcheckmass) THEN
3011	DO itr = 1, nbtr
3012	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3013	pplay, t_seri, iscm3, 'after trconv')
3014	ENDDO
3015	ENDIF
3016	CALL minmaxsource(source_tr, qmin, qmax, 'src: after trconv')
3017	ENDIF
3018	ENDIF ! convection
3019
3020	IF (logitime) THEN
3021	CALL SYSTEM_CLOCK(COUNT = clock_end)
3022	dife = clock_end - clock_start
3023	ti_cvltr = dife * MAX(0, SIGN(1, dife)) &
3024	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3025	tia_cvltr = tia_cvltr + REAL(ti_cvltr) / REAL(clock_rate)
3026	ENDIF
3027
3028
3029	!=======================================================================
3030	! LARGE SCALE SCAVENGING KE
3031	!=======================================================================
3032
3033	#ifdef IOPHYS_DUST
3034	CALL iophys_ecrit('da',klev,'da','',da)
3035	CALL iophys_ecrit('phi',klev,'phi','',phi)
3036	CALL iophys_ecrit('phi2',klev,'phi2','',phi2)
3037	CALL iophys_ecrit('d1a',klev,'d1a','',d1a)
3038	CALL iophys_ecrit('dam',klev,'dam','',dam)
3039	CALL iophys_ecrit('mp',klev,'mp','',mp)
3040	CALL iophys_ecrit('ep',klev,'ep','',ep)
3041	CALL iophys_ecrit('sigd',klev,'sigd','',sigd)
3042	CALL iophys_ecrit('sij',klev,'sij','',sij)
3043	CALL iophys_ecrit('wght_cvfd',klev,'wght_cvfd','',wght_cvfd)
3044	CALL iophys_ecrit('clw',klev,'clw','',clw)
3045	CALL iophys_ecrit('elij',klev,'elij','',elij)
3046	CALL iophys_ecrit('epmlmMm',klev,'epmlmMm','',epmlmMm)
3047	CALL iophys_ecrit('eplaMm',klev,'eplaMm','',eplaMm)
3048	CALL iophys_ecrit('pmflxr',klev,'pmflxr','',pmflxr)
3049	CALL iophys_ecrit('pmflxs',klev,'pmflxs','',pmflxs)
3050	CALL iophys_ecrit('evapls',klev,'evapls','',evapls)
3051	CALL iophys_ecrit('wdtrainA',klev,'wdtrainA','',wdtrainA)
3052	CALL iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM)
3053
3054	do itr=1,nbtr
3055	WRITE(str2,'(i2.2)') itr
3056	CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3057	enddo
3058	#endif
3059
3060
3061	IF (iflag_conv>=3) THEN
3062	IF (logitime) THEN
3063	CALL SYSTEM_CLOCK(COUNT = clock_start)
3064	ENDIF
3065
3066	IF (lessivage) THEN
3067	print *, ' BEFORE lsc_scav '
3068	IF (lminmax) THEN
3069	DO itr = 1, nbtr
3070	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_lsc_scav')
3071	ENDDO
3072	DO itr = 1, nbtr
3073	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before lsc_scav')
3074	ENDDO
3075	IF (lcheckmass) THEN
3076	DO itr = 1, nbtr
3077	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3078	pplay, t_seri, iscm3, 'before lsc_scav')
3079	ENDDO
3080	ENDIF
3081	CALL minmaxsource(source_tr, qmin, qmax, 'src: before lsc_scav')
3082	ENDIF
3083
3084	ql_incloud_ref = 10.e-4
3085	ql_incloud_ref = 5.e-4
3086	! calcul du contenu en eau liquide au sein du nuage
3087	ql_incl = ql_incloud_ref
3088	! choix du lessivage
3089	IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
3090	!IF (.FALSE.) THEN ! test #DFB (Binta) sans lsc_scav_spl
3091	print *, 'JE iflag_lscav', iflag_lscav
3092	DO itr = 1, nbtr
3093
3094	! incloud scavenging and removal by large scale rain ! orig : ql_incl
3095	! was replaced by 0.5e-3 kg/kg
3096	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
3097	! Liu (2001) proposed to use 1.5e-3 kg/kg
3098
3099	! CALL lsc_scav_orig(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,
3100	! . rneb,beta_fisrt, beta_v1,pplay,paprs,
3101	! . t_seri,tr_seri,d_tr_insc,
3102	! . d_tr_bcscav,d_tr_evapls,qPrls)
3103	CALL lsc_scav_spl(pdtphys, itr, iflag_lscav, ql_incl, prfl, psfl, &
3104	rneb, beta_fisrt, beta_v1, pplay, paprs, &
3105	t_seri, tr_seri, d_tr_insc, &
3106	alpha_r, alpha_s, kk, henry, &
3107	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3108	d_tr_bcscav, d_tr_evapls, qPrls)
3109
3110	!large scale scavenging tendency
3111	DO k = 1, klev
3112	DO i = 1, klon
3113	d_tr_ls(i, k, itr) = d_tr_insc(i, k, itr) + d_tr_bcscav(i, k, itr) &
3114	+ d_tr_evapls(i, k, itr)
3115	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr_ls(i, k, itr)
3116	tmp_var(i, k) = d_tr_ls(i, k, itr)
3117	ENDDO
3118	ENDDO
3119
3120	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3121
3122	DO k = 1, klev
3123	DO i = 1, klon
3124	his_dhkelsc(i, itr) = his_dhkelsc(i, itr) - tmp_var(i, k) &
3125	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3126
3127	END DO
3128	END DO
3129
3130	END DO !it=1,nbtr
3131
3132	ELSE
3133	print *, 'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
3134	DO itr = 1, nbtr
3135	DO i = 1, klon
3136	his_dhkelsc(i, itr) = 0.0
3137	END DO ! klon
3138	END DO !it=1,nbtr
3139	ENDIF !iflag_lscav
3140
3141	print *, ' AFTER lsc_scav '
3142	IF (lminmax) THEN
3143	DO itr = 1, nbtr
3144	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_lsc_scav')
3145	ENDDO
3146	DO itr = 1, nbtr
3147	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after lsc_scav')
3148	ENDDO
3149	IF (lcheckmass) THEN
3150	DO itr = 1, nbtr
3151	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3152	pplay, t_seri, iscm3, 'after lsc_scav')
3153	ENDDO
3154	ENDIF
3155	CALL minmaxsource(source_tr, qmin, qmax, 'src: after lsc_scav')
3156	ENDIF
3157
3158	ENDIF ! lessivage
3159
3160	IF (logitime) THEN
3161	CALL SYSTEM_CLOCK(COUNT = clock_end)
3162	dife = clock_end - clock_start
3163	ti_lscs = dife * MAX(0, SIGN(1, dife)) &
3164	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3165	tia_lscs = tia_lscs + REAL(ti_lscs) / REAL(clock_rate)
3166	ENDIF
3167
3168	ENDIF !iflag_conv
3169
3170
3171	!=======================================================================
3172	! COMPUTING THE BURDEN
3173	!=======================================================================
3174	#ifdef IOPHYS_DUST
3175	do itr=1,nbtr
3176	WRITE(str2,'(i2.2)') itr
3177	CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3178	enddo
3179	#endif
3180
3181	IF (logitime) THEN
3182	CALL SYSTEM_CLOCK(COUNT = clock_start)
3183	ENDIF
3184
3185	DO itr = 1, nbtr
3186	DO j = 1, klev
3187	DO i = 1, klon
3188	tmp_var(i, j) = tr_seri(i, j, itr)
3189	ENDDO
3190	ENDDO
3191	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3192	DO j = 1, klev
3193	DO i = 1, klon
3194	tr_seri(i, j, itr) = tmp_var(i, j)
3195	ENDDO
3196	ENDDO
3197	ENDDO
3198	iscm3 = .TRUE.
3199
3200	! Computing burden in mg/m2
3201	DO itr = 1, nbtr
3202	DO k = 1, klev
3203	DO i = 1, klon
3204	trm(i, itr) = trm(i, itr) + tr_seri(i, k, itr) * 1.e6 * zdz(i, k) * &
3205	masse(itr) * 1.e3 / RNAVO !--mg S/m2
3206	ENDDO
3207	ENDDO
3208	ENDDO
3209
3210	! Computing Surface concentration in ug/m3
3211
3212	DO itr = 1, nbtr
3213	DO i = 1, klon
3214	sconc_seri(i, itr) = tr_seri(i, 1, itr) * 1.e6 * &
3215	masse(itr) * 1.e3 / RNAVO !--mg/m3 (tr_seri ist in g/cm3)
3216	ENDDO
3217	ENDDO
3218
3219	!=======================================================================
3220	! CALCULATION OF OPTICAL PROPERTIES
3221	!=======================================================================
3222
3223	CALL aeropt_spl(zdz, tr_seri, RHcl, &
3224	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3225	ok_chimeredust, &
3226	diff_aod550_tot, diag_aod670_tot, diag_aod865_tot, &
3227	diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, &
3228	diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, &
3229	diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, &
3230	diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco)
3231
3232	IF (logitime) THEN
3233	CALL SYSTEM_CLOCK(COUNT = clock_end)
3234	dife = clock_end - clock_start
3235	ti_brop = dife * MAX(0, SIGN(1, dife)) &
3236	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3237	tia_brop = tia_brop + REAL(ti_brop) / REAL(clock_rate)
3238	ENDIF
3239
3240
3241	!=======================================================================
3242	! MODIS terra/aqua simulation output
3243	!=======================================================================
3244	masque_aqua_cur(:) = 0
3245	masque_terra_cur(:) = 0
3246
3247	CALL satellite_out_spla(jD_cur, jH_cur, pdtphys, rlat, rlon, &
3248	masque_aqua_cur, masque_terra_cur)
3249	IF (jH_cur - pdtphys / 86400. < 0.) THEN
3250	!new utc day: put in 0 everything
3251	!JE20150518<<
3252	masque_aqua(:) = 0
3253	masque_terra(:) = 0
3254	aod550_terra(:) = 0.
3255	aod550_tr2_terra(:) = 0.
3256	aod550_ss_terra(:) = 0.
3257	aod550_dust_terra(:) = 0.
3258	aod550_dustsco_terra(:) = 0.
3259	aod670_terra(:) = 0.
3260	aod670_tr2_terra(:) = 0.
3261	aod670_ss_terra(:) = 0.
3262	aod670_dust_terra(:) = 0.
3263	aod670_dustsco_terra(:) = 0.
3264	aod865_terra(:) = 0.
3265	aod865_tr2_terra(:) = 0.
3266	aod865_ss_terra(:) = 0.
3267	aod865_dust_terra(:) = 0.
3268	aod865_dustsco_terra(:) = 0.
3269	aod550_aqua(:) = 0.
3270	aod550_tr2_aqua(:) = 0.
3271	aod550_ss_aqua(:) = 0.
3272	aod550_dust_aqua(:) = 0.
3273	aod550_dustsco_aqua(:) = 0.
3274	aod670_aqua(:) = 0.
3275	aod670_tr2_aqua(:) = 0.
3276	aod670_ss_aqua(:) = 0.
3277	aod670_dust_aqua(:) = 0.
3278	aod670_dustsco_aqua(:) = 0.
3279	aod865_aqua(:) = 0.
3280	aod865_tr2_aqua(:) = 0.
3281	aod865_ss_aqua(:) = 0.
3282	aod865_dust_aqua(:) = 0.
3283	aod865_dustsco_aqua(:) = 0.
3284	!JE20150518>>
3285	ENDIF
3286
3287	DO i = 1, klon
3288
3289	aod550_terra(i) = aod550_terra(i) + &
3290	masque_terra_cur(i) * diff_aod550_tot(i)
3291	aod550_tr2_terra(i) = aod550_tr2_terra(i) + &
3292	masque_terra_cur(i) * diff_aod550_tr2(i)
3293	aod550_ss_terra(i) = aod550_ss_terra(i) + &
3294	masque_terra_cur(i) * diag_aod550_ss(i)
3295	aod550_dust_terra(i) = aod550_dust_terra(i) + &
3296	masque_terra_cur(i) * diag_aod550_dust(i)
3297	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) + &
3298	masque_terra_cur(i) * diag_aod550_dustsco(i)
3299	aod670_terra(i) = aod670_terra(i) + &
3300	masque_terra_cur(i) * diag_aod670_tot(i)
3301	aod670_tr2_terra(i) = aod670_tr2_terra(i) + &
3302	masque_terra_cur(i) * diag_aod670_tr2(i)
3303	aod670_ss_terra(i) = aod670_ss_terra(i) + &
3304	masque_terra_cur(i) * diag_aod670_ss(i)
3305	aod670_dust_terra(i) = aod670_dust_terra(i) + &
3306	masque_terra_cur(i) * diag_aod670_dust(i)
3307	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) + &
3308	masque_terra_cur(i) * diag_aod670_dustsco(i)
3309	aod865_terra(i) = aod865_terra(i) + &
3310	masque_terra_cur(i) * diag_aod865_tot(i)
3311	aod865_tr2_terra(i) = aod865_tr2_terra(i) + &
3312	masque_terra_cur(i) * diag_aod865_tr2(i)
3313	aod865_ss_terra(i) = aod865_ss_terra(i) + &
3314	masque_terra_cur(i) * diag_aod865_ss(i)
3315	aod865_dust_terra(i) = aod865_dust_terra(i) + &
3316	masque_terra_cur(i) * diag_aod865_dust(i)
3317	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) + &
3318	masque_terra_cur(i) * diag_aod865_dustsco(i)
3319
3320	aod550_aqua(i) = aod550_aqua(i) + &
3321	masque_aqua_cur(i) * diff_aod550_tot(i)
3322	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) + &
3323	masque_aqua_cur(i) * diff_aod550_tr2(i)
3324	aod550_ss_aqua(i) = aod550_ss_aqua(i) + &
3325	masque_aqua_cur(i) * diag_aod550_ss(i)
3326	aod550_dust_aqua(i) = aod550_dust_aqua(i) + &
3327	masque_aqua_cur(i) * diag_aod550_dust(i)
3328	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) + &
3329	masque_aqua_cur(i) * diag_aod550_dustsco(i)
3330	aod670_aqua(i) = aod670_aqua(i) + &
3331	masque_aqua_cur(i) * diag_aod670_tot(i)
3332	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) + &
3333	masque_aqua_cur(i) * diag_aod670_tr2(i)
3334	aod670_ss_aqua(i) = aod670_ss_aqua(i) + &
3335	masque_aqua_cur(i) * diag_aod670_ss(i)
3336	aod670_dust_aqua(i) = aod670_dust_aqua(i) + &
3337	masque_aqua_cur(i) * diag_aod670_dust(i)
3338	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) + &
3339	masque_aqua_cur(i) * diag_aod670_dustsco(i)
3340	aod865_aqua(i) = aod865_aqua(i) + &
3341	masque_aqua_cur(i) * diag_aod865_tot(i)
3342	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) + &
3343	masque_aqua_cur(i) * diag_aod865_tr2(i)
3344	aod865_ss_aqua(i) = aod865_ss_aqua(i) + &
3345	masque_aqua_cur(i) * diag_aod865_ss(i)
3346	aod865_dust_aqua(i) = aod865_dust_aqua(i) + &
3347	masque_aqua_cur(i) * diag_aod865_dust(i)
3348	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) + &
3349	masque_aqua_cur(i) * diag_aod865_dustsco(i)
3350
3351	masque_aqua(i) = masque_aqua(i) + masque_aqua_cur(i)
3352	masque_terra(i) = masque_terra(i) + masque_terra_cur(i)
3353	ENDDO
3354
3355	IF (jH_cur + pdtphys / 86400. >= 1.) THEN
3356	! print *,'last step of the day'
3357	DO i = 1, klon
3358	IF (masque_aqua(i)> 0) THEN
3359	aod550_aqua(i) = aod550_aqua(i) / masque_aqua(i)
3360	aod670_aqua(i) = aod670_aqua(i) / masque_aqua(i)
3361	aod865_aqua(i) = aod865_aqua(i) / masque_aqua(i)
3362	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) / masque_aqua(i)
3363	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) / masque_aqua(i)
3364	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) / masque_aqua(i)
3365	aod550_ss_aqua(i) = aod550_ss_aqua(i) / masque_aqua(i)
3366	aod670_ss_aqua(i) = aod670_ss_aqua(i) / masque_aqua(i)
3367	aod865_ss_aqua(i) = aod865_ss_aqua(i) / masque_aqua(i)
3368	aod550_dust_aqua(i) = aod550_dust_aqua(i) / masque_aqua(i)
3369	aod670_dust_aqua(i) = aod670_dust_aqua(i) / masque_aqua(i)
3370	aod865_dust_aqua(i) = aod865_dust_aqua(i) / masque_aqua(i)
3371	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) / masque_aqua(i)
3372	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) / masque_aqua(i)
3373	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) / masque_aqua(i)
3374	ELSE
3375	aod550_aqua(i) = -999.
3376	aod670_aqua(i) = -999.
3377	aod865_aqua(i) = -999.
3378	aod550_tr2_aqua(i) = -999.
3379	aod670_tr2_aqua(i) = -999.
3380	aod865_tr2_aqua(i) = -999.
3381	aod550_ss_aqua(i) = -999.
3382	aod670_ss_aqua(i) = -999.
3383	aod865_ss_aqua(i) = -999.
3384	aod550_dust_aqua(i) = -999.
3385	aod670_dust_aqua(i) = -999.
3386	aod865_dust_aqua(i) = -999.
3387	aod550_dustsco_aqua(i) = -999.
3388	aod670_dustsco_aqua(i) = -999.
3389	aod865_dustsco_aqua(i) = -999.
3390	ENDIF
3391	IF (masque_terra(i)> 0) THEN
3392	aod550_terra(i) = aod550_terra(i) / masque_terra(i)
3393	aod670_terra(i) = aod670_terra(i) / masque_terra(i)
3394	aod865_terra(i) = aod865_terra(i) / masque_terra(i)
3395	aod550_tr2_terra(i) = aod550_tr2_terra(i) / masque_terra(i)
3396	aod670_tr2_terra(i) = aod670_tr2_terra(i) / masque_terra(i)
3397	aod865_tr2_terra(i) = aod865_tr2_terra(i) / masque_terra(i)
3398	aod550_ss_terra(i) = aod550_ss_terra(i) / masque_terra(i)
3399	aod670_ss_terra(i) = aod670_ss_terra(i) / masque_terra(i)
3400	aod865_ss_terra(i) = aod865_ss_terra(i) / masque_terra(i)
3401	aod550_dust_terra(i) = aod550_dust_terra(i) / masque_terra(i)
3402	aod670_dust_terra(i) = aod670_dust_terra(i) / masque_terra(i)
3403	aod865_dust_terra(i) = aod865_dust_terra(i) / masque_terra(i)
3404	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) / masque_terra(i)
3405	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) / masque_terra(i)
3406	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) / masque_terra(i)
3407	ELSE
3408	aod550_terra(i) = -999.
3409	aod670_terra(i) = -999.
3410	aod865_terra(i) = -999.
3411	aod550_tr2_terra(i) = -999.
3412	aod670_tr2_terra(i) = -999.
3413	aod865_tr2_terra(i) = -999.
3414	aod550_ss_terra(i) = -999.
3415	aod670_ss_terra(i) = -999.
3416	aod865_ss_terra(i) = -999.
3417	aod550_dust_terra(i) = -999.
3418	aod670_dust_terra(i) = -999.
3419	aod865_dust_terra(i) = -999.
3420	aod550_dustsco_terra(i) = -999.
3421	aod670_dustsco_terra(i) = -999.
3422	aod865_dustsco_terra(i) = -999.
3423	ENDIF
3424	ENDDO
3425
3426	!!AS deleting lines
3427	!! IF (ok_histrac) THEN
3428	!!!! write in output file
3429	!!----many deleted lines
3430	!! ENDIF !mpi_root
3431	!!!$OMP END MASTER
3432	!!!$OMP BARRIER
3433	!! ENDIF !--ok_histrac
3434
3435	ENDIF ! jH_cur...
3436
3437	!======================================================================
3438	! Stockage sur bande histoire
3439	!======================================================================
3440	#ifdef IOPHYS_DUST
3441	do itr=1,nbtr
3442	WRITE(str2,'(i2.2)') itr
3443	CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3444	enddo
3445	#endif
3446
3447	IF (logitime) THEN
3448	CALL SYSTEM_CLOCK(COUNT = clock_start)
3449	ENDIF
3450
3451	DO itr = 1, nbtr
3452	DO j = 1, klev
3453	DO i = 1, klon
3454	tmp_var(i, j) = tr_seri(i, j, itr)
3455	ENDDO
3456	ENDDO
3457	CALL cm3_to_kg(pplay, t_seri, tmp_var)
3458	DO j = 1, klev
3459	DO i = 1, klon
3460	tr_seri(i, j, itr) = tmp_var(i, j)
3461	ENDDO
3462	ENDDO
3463	ENDDO
3464	iscm3 = .FALSE.
3465
3466
3467	!======================================================================
3468	! SAVING AEROSOL RELATED VARIABLES INTO FILE
3469	!======================================================================
3470
3471	ndex2d = 0
3472	ndex3d = 0
3473
3474	itra = itra + 1
3475
3476	print *, 'SAVING VARIABLES FOR DAY ', itra
3477
3478	fluxbb(:) = 0.0
3479	fluxff(:) = 0.0
3480	fluxbcbb(:) = 0.0
3481	fluxbcff(:) = 0.0
3482	fluxbcnff(:) = 0.0
3483	fluxbcba(:) = 0.0
3484	fluxbc(:) = 0.0
3485	fluxombb(:) = 0.0
3486	fluxomff(:) = 0.0
3487	fluxomnat(:) = 0.0
3488	fluxomba(:) = 0.0
3489	fluxomnff(:) = 0.0
3490	fluxom(:) = 0.0
3491	fluxh2sff(:) = 0.0
3492	fluxh2snff(:) = 0.0
3493	fluxh2sbio(:) = 0.0
3494	fluxso2ff(:) = 0.0
3495	fluxso2nff(:) = 0.0
3496	fluxso2bb(:) = 0.0
3497	fluxso2vol(:) = 0.0
3498	fluxso2ba(:) = 0.0
3499	fluxso2(:) = 0.0
3500	fluxso4ff(:) = 0.0
3501	fluxso4nff(:) = 0.0
3502	fluxso4bb(:) = 0.0
3503	fluxso4ba(:) = 0.0
3504	fluxso4(:) = 0.0
3505	fluxdms(:) = 0.0
3506	fluxdustec(:) = 0.0
3507	fluxddfine(:) = 0.0
3508	fluxddcoa(:) = 0.0
3509	fluxddsco(:) = 0.0
3510	fluxdd(:) = 0.0
3511	fluxssfine(:) = 0.0
3512	fluxsscoa(:) = 0.0
3513	fluxss(:) = 0.0
3514	DO i = 1, klon
3515	IF (iregion_ind(i)>0) THEN ! LAND
3516	! SULFUR EMISSIONS
3517	fluxh2sff(i) = (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * frach2sofso2 * &
3518	scale_param_ind(iregion_ind(i)) * &
3519	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3520	fluxso2ff(i) = scale_param_ind(iregion_ind(i)) * fracso2emis * &
3521	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3522	masse_s * 1.e3 ! mgS/m2/s
3523	! SULPHATE EMISSIONS
3524	fluxso4ff(i) = scale_param_ind(iregion_ind(i)) * (1 - fracso2emis) * &
3525	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3526	masse_s * 1.e3 ! mgS/m2/s
3527	! BLACK CARBON EMISSIONS
3528	fluxbcff(i) = scale_param_ff(iregion_ind(i)) * &
3529	lmt_bcff(i) * 1.e4 * 1.e3 !/g/m2/s
3530	! ORGANIC MATTER EMISSIONS
3531	fluxomff(i) = scale_param_ff(iregion_ind(i)) * &
3532	(lmt_omff(i)) * 1.e4 * 1.e3 !/g/m2/s
3533	! FOSSIL FUEL EMISSIONS
3534	fluxff(i) = fluxbcff(i) + fluxomff(i)
3535	ENDIF
3536	IF (iregion_bb(i)>0) THEN ! LAND
3537	! SULFUR EMISSIONS
3538	fluxso2bb(i) = scale_param_bb(iregion_bb(i)) * fracso2emis * &
3539	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3540	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3541	! SULPHATE EMISSIONS
3542	fluxso4bb(i) = scale_param_bb(iregion_bb(i)) * (1 - fracso2emis) * &
3543	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3544	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3545	! BLACK CARBON EMISSIONS
3546	fluxbcbb(i) = scale_param_bb(iregion_bb(i)) * &
3547	(lmt_bcbb_l(i) + lmt_bcbb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3548	! ORGANIC MATTER EMISSIONS
3549	fluxombb(i) = scale_param_bb(iregion_bb(i)) * &
3550	(lmt_ombb_l(i) + lmt_ombb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3551	! BIOMASS BURNING EMISSIONS
3552	fluxbb(i) = fluxbcbb(i) + fluxombb(i)
3553	ENDIF
3554	! H2S EMISSIONS
3555	fluxh2sbio(i) = lmt_h2sbio(i) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3556	fluxh2snff(i) = lmt_so2nff(i) * frach2sofso2 * &
3557	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3558	! SULFUR DIOXIDE EMISSIONS
3559	fluxso2nff(i) = fracso2emis * lmt_so2nff(i) * 1.e4 / RNAVO * &
3560	masse_s * 1.e3 ! mgS/m2/s
3561	fluxso2vol(i) = (lmt_so2volc_cont(i) + lmt_so2volc_expl(i)) &
3562	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3563	fluxso2ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 * &
3564	fracso2emis ! mgS/m2/s
3565	fluxso2(i) = fluxso2ff(i) + fluxso2bb(i) + fluxso2nff(i) + &
3566	fluxso2vol(i) + fluxso2ba(i)
3567	! DMS EMISSIONS
3568	fluxdms(i) = (lmt_dms(i) + lmt_dmsbio(i)) &
3569	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3570	! SULPHATE EMISSIONS
3571	fluxso4ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 &
3572	* (1 - fracso2emis) ! mgS/m2/s
3573	fluxso4nff(i) = (1 - fracso2emis) * lmt_so2nff(i) * 1.e4 / RNAVO * &
3574	masse_s * 1.e3 ! mgS/m2/s
3575	fluxso4(i) = fluxso4ff(i) + fluxso4bb(i) + fluxso4ba(i) + fluxso4nff(i)
3576	! BLACK CARBON EMISSIONS
3577
3578	fluxbcnff(i) = lmt_bcnff(i) * 1.e4 * 1.e3 !mg/m2/s
3579	fluxbcba(i) = lmt_bcba(i) * 1.e4 * 1.e3 !mg/m2/s
3580	fluxbc(i) = fluxbcbb(i) + fluxbcff(i) + fluxbcnff(i) + fluxbcba(i)
3581	! ORGANIC MATTER EMISSIONS
3582	fluxomnat(i) = lmt_omnat(i) * 1.e4 * 1.e3 !mg/m2/s
3583	fluxomba(i) = lmt_omba(i) * 1.e4 * 1.e3 !mg/m2/s
3584	fluxomnff(i) = lmt_omnff(i) * 1.e4 * 1.e3 !mg/m2/s
3585	fluxom(i) = fluxombb(i) + fluxomff(i) + fluxomnat(i) + fluxomba(i) + &
3586	fluxomnff(i)
3587	! DUST EMISSIONS
3588	fluxdustec(i) = dust_ec(i) * 1.e6 ! old dust emission scheme
3589	!JE20140605<< old dust emission version
3590	! fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
3591	! . * dust_ec(i)0.0931.e6
3592	! fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
3593	! . * dust_ec(i)0.9051.e6
3594	! fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
3595	!JE20140605>>
3596	fluxddfine(i) = flux_sparam_ddfine(i)
3597	fluxddcoa(i) = flux_sparam_ddcoa(i)
3598	fluxddsco(i) = flux_sparam_ddsco(i)
3599	fluxdd(i) = fluxddfine(i) + fluxddcoa(i) + fluxddsco(i)
3600	! SEA SALT EMISSIONS
3601	fluxssfine(i) = scale_param_ssacc * lmt_sea_salt(i, 1) * 1.e4 * 1.e3
3602	fluxsscoa(i) = scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3
3603	fluxss(i) = fluxssfine(i) + fluxsscoa(i)
3604	ENDDO
3605
3606	! prepare outputs cvltr
3607
3608	DO itr = 1, nbtr
3609	DO k = 1, klev
3610	DO i = 1, klon
3611	tmp_var(i, k) = d_tr_cv(i, k, itr)
3612	ENDDO
3613	ENDDO
3614	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3615	DO k = 1, klev
3616	DO i = 1, klon
3617	d_tr_cv_o(i, k, itr) = tmp_var(i, k) &
3618	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3619	ENDDO
3620	ENDDO
3621	ENDDO
3622	DO itr = 1, nbtr
3623	DO k = 1, klev
3624	DO i = 1, klon
3625	tmp_var(i, k) = d_tr_trsp(i, k, itr)
3626	ENDDO
3627	ENDDO
3628	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3629	DO k = 1, klev
3630	DO i = 1, klon
3631	d_tr_trsp_o(i, k, itr) = tmp_var(i, k) &
3632	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3633	ENDDO
3634	ENDDO
3635	ENDDO
3636	DO itr = 1, nbtr
3637	DO k = 1, klev
3638	DO i = 1, klon
3639	tmp_var(i, k) = d_tr_sscav(i, k, itr)
3640	ENDDO
3641	ENDDO
3642	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3643	DO k = 1, klev
3644	DO i = 1, klon
3645	d_tr_sscav_o(i, k, itr) = tmp_var(i, k) &
3646	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3647	ENDDO
3648	ENDDO
3649	ENDDO
3650	DO itr = 1, nbtr
3651	DO k = 1, klev
3652	DO i = 1, klon
3653	tmp_var(i, k) = d_tr_sat(i, k, itr)
3654	ENDDO
3655	ENDDO
3656	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3657	DO k = 1, klev
3658	DO i = 1, klon
3659	d_tr_sat_o(i, k, itr) = tmp_var(i, k) &
3660	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3661	ENDDO
3662	ENDDO
3663	ENDDO
3664	DO itr = 1, nbtr
3665	DO k = 1, klev
3666	DO i = 1, klon
3667	tmp_var(i, k) = d_tr_uscav(i, k, itr)
3668	ENDDO
3669	ENDDO
3670	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3671	DO k = 1, klev
3672	DO i = 1, klon
3673	d_tr_uscav_o(i, k, itr) = tmp_var(i, k) &
3674	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3675	ENDDO
3676	ENDDO
3677	ENDDO
3678	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3679	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3680	DO itr = 1, nbtr
3681	DO k = 1, klev
3682	DO i = 1, klon
3683	tmp_var(i, k) = d_tr_insc(i, k, itr)
3684	ENDDO
3685	ENDDO
3686	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3687	DO k = 1, klev
3688	DO i = 1, klon
3689	d_tr_insc_o(i, k, itr) = tmp_var(i, k) &
3690	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3691	ENDDO
3692	ENDDO
3693	ENDDO
3694
3695	DO itr = 1, nbtr
3696	DO k = 1, klev
3697	DO i = 1, klon
3698	tmp_var(i, k) = d_tr_bcscav(i, k, itr)
3699	ENDDO
3700	ENDDO
3701	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3702	DO k = 1, klev
3703	DO i = 1, klon
3704	d_tr_bcscav_o(i, k, itr) = tmp_var(i, k) &
3705	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3706	ENDDO
3707	ENDDO
3708	ENDDO
3709
3710	DO itr = 1, nbtr
3711	DO k = 1, klev
3712	DO i = 1, klon
3713	tmp_var(i, k) = d_tr_evapls(i, k, itr)
3714	ENDDO
3715	ENDDO
3716	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3717	DO k = 1, klev
3718	DO i = 1, klon
3719	d_tr_evapls_o(i, k, itr) = tmp_var(i, k) &
3720	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3721	ENDDO
3722	ENDDO
3723	ENDDO
3724
3725	DO itr = 1, nbtr
3726	DO k = 1, klev
3727	DO i = 1, klon
3728	tmp_var(i, k) = d_tr_ls(i, k, itr)
3729	ENDDO
3730	ENDDO
3731	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3732	DO k = 1, klev
3733	DO i = 1, klon
3734	d_tr_ls_o(i, k, itr) = tmp_var(i, k) &
3735	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3736	ENDDO
3737	ENDDO
3738	ENDDO
3739
3740	DO itr = 1, nbtr
3741	DO k = 1, klev
3742	DO i = 1, klon
3743	tmp_var(i, k) = d_tr_dyn(i, k, itr)
3744	ENDDO
3745	ENDDO
3746	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3747	DO k = 1, klev
3748	DO i = 1, klon
3749	d_tr_dyn_o(i, k, itr) = tmp_var(i, k) &
3750	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3751	ENDDO
3752	ENDDO
3753	ENDDO
3754
3755	DO itr = 1, nbtr
3756	DO k = 1, klev
3757	DO i = 1, klon
3758	tmp_var(i, k) = d_tr_cl(i, k, itr)
3759	ENDDO
3760	ENDDO
3761	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3762	DO k = 1, klev
3763	DO i = 1, klon
3764	d_tr_cl_o(i, k, itr) = tmp_var(i, k) &
3765	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3766	ENDDO
3767	ENDDO
3768	ENDDO
3769
3770	DO itr = 1, nbtr
3771	DO k = 1, klev
3772	DO i = 1, klon
3773	tmp_var(i, k) = d_tr_th(i, k, itr)
3774	ENDDO
3775	ENDDO
3776	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3777	DO k = 1, klev
3778	DO i = 1, klon
3779	d_tr_th_o(i, k, itr) = tmp_var(i, k) &
3780	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3781	ENDDO
3782	ENDDO
3783	ENDDO
3784	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3785	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3786
3787	DO itr = 1, nbtr
3788	WRITE(str2, '(i2.2)') itr
3789	DO i = 1, klon
3790	his_dh(i, itr) = his_dhlsc(i, itr) + his_dhcon(i, itr) + &
3791	his_dhbclsc(i, itr) + his_dhbccon(i, itr)
3792
3793	ENDDO
3794	ENDDO
3795
3796	!AS: commenting out and deleting lines
3797	!! IF (ok_histrac) THEN
3798	!!
3799	!! SAVING VARIABLES IN TRACEUR
3800	!!----- many lines deleted----
3801	!! ENDIF ! ok_histrac
3802
3803
3804
3805
3806	!JE20141224
3807	! saving variables for output
3808	! 2D outputs
3809	DO i = 1, klon
3810	trm01(i) = 0.
3811	trm02(i) = 0.
3812	trm03(i) = 0.
3813	trm04(i) = 0.
3814	trm05(i) = 0.
3815	sconc01(i) = 0.
3816	sconc02(i) = 0.
3817	sconc03(i) = 0.
3818	sconc04(i) = 0.
3819	sconc05(i) = 0.
3820	flux01(i) = 0.
3821	flux02(i) = 0.
3822	flux03(i) = 0.
3823	flux04(i) = 0.
3824	flux05(i) = 0.
3825	ds01(i) = 0.
3826	ds02(i) = 0.
3827	ds03(i) = 0.
3828	ds04(i) = 0.
3829	ds05(i) = 0.
3830	dh01(i) = 0.
3831	dh02(i) = 0.
3832	dh03(i) = 0.
3833	dh04(i) = 0.
3834	dh05(i) = 0.
3835	dtrconv01(i) = 0.
3836	dtrconv02(i) = 0.
3837	dtrconv03(i) = 0.
3838	dtrconv04(i) = 0.
3839	dtrconv05(i) = 0.
3840	dtherm01(i) = 0.
3841	dtherm02(i) = 0.
3842	dtherm03(i) = 0.
3843	dtherm04(i) = 0.
3844	dtherm05(i) = 0.
3845	dhkecv01(i) = 0.
3846	dhkecv02(i) = 0.
3847	dhkecv03(i) = 0.
3848	dhkecv04(i) = 0.
3849	dhkecv05(i) = 0.
3850	d_tr_ds01(i) = 0.
3851	d_tr_ds02(i) = 0.
3852	d_tr_ds03(i) = 0.
3853	d_tr_ds04(i) = 0.
3854	d_tr_ds05(i) = 0.
3855	dhkelsc01(i) = 0.
3856	dhkelsc02(i) = 0.
3857	dhkelsc03(i) = 0.
3858	dhkelsc04(i) = 0.
3859	dhkelsc05(i) = 0.
3860	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3861
3862	IF(id_prec>0) trm01(i) = trm(i, id_prec)
3863	IF(id_fine>0) trm02(i) = trm(i, id_fine)
3864	IF(id_coss>0) trm03(i) = trm(i, id_coss)
3865	IF(id_codu>0) trm04(i) = trm(i, id_codu)
3866	IF(id_scdu>0) trm05(i) = trm(i, id_scdu)
3867	IF(id_prec>0) sconc01(i) = sconc_seri(i, id_prec)
3868	IF(id_fine>0) sconc02(i) = sconc_seri(i, id_fine)
3869	IF(id_coss>0) sconc03(i) = sconc_seri(i, id_coss)
3870	IF(id_codu>0) sconc04(i) = sconc_seri(i, id_codu)
3871	IF(id_scdu>0) sconc05(i) = sconc_seri(i, id_scdu)
3872	IF(id_prec>0) flux01(i) = flux_tr(i, id_prec)
3873	IF(id_fine>0) flux02(i) = flux_tr(i, id_fine)
3874	IF(id_coss>0) flux03(i) = flux_tr(i, id_coss)
3875	IF(id_codu>0) flux04(i) = flux_tr(i, id_codu)
3876	IF(id_scdu>0) flux05(i) = flux_tr(i, id_scdu)
3877	IF(id_prec>0) ds01(i) = his_ds(i, id_prec)
3878	IF(id_fine>0) ds02(i) = his_ds(i, id_fine)
3879	IF(id_coss>0) ds03(i) = his_ds(i, id_coss)
3880	IF(id_codu>0) ds04(i) = his_ds(i, id_codu)
3881	IF(id_scdu>0) ds05(i) = his_ds(i, id_scdu)
3882	IF(id_prec>0) dh01(i) = his_dh(i, id_prec)
3883	IF(id_fine>0) dh02(i) = his_dh(i, id_fine)
3884	IF(id_coss>0) dh03(i) = his_dh(i, id_coss)
3885	IF(id_codu>0) dh04(i) = his_dh(i, id_codu)
3886	IF(id_scdu>0) dh05(i) = his_dh(i, id_scdu)
3887	IF(id_prec>0) dtrconv01(i) = dtrconv(i, id_prec)
3888	IF(id_fine>0) dtrconv02(i) = dtrconv(i, id_fine)
3889	IF(id_coss>0) dtrconv03(i) = dtrconv(i, id_coss)
3890	IF(id_codu>0) dtrconv04(i) = dtrconv(i, id_codu)
3891	IF(id_scdu>0) dtrconv05(i) = dtrconv(i, id_scdu)
3892	IF(id_prec>0) dtherm01(i) = his_th(i, id_prec)
3893	IF(id_fine>0) dtherm02(i) = his_th(i, id_fine)
3894	IF(id_coss>0) dtherm03(i) = his_th(i, id_coss)
3895	IF(id_codu>0) dtherm04(i) = his_th(i, id_codu)
3896	IF(id_scdu>0) dtherm05(i) = his_th(i, id_scdu)
3897	IF(id_prec>0) dhkecv01(i) = his_dhkecv(i, id_prec)
3898	IF(id_fine>0) dhkecv02(i) = his_dhkecv(i, id_fine)
3899	IF(id_coss>0) dhkecv03(i) = his_dhkecv(i, id_coss)
3900	IF(id_codu>0) dhkecv04(i) = his_dhkecv(i, id_codu)
3901	IF(id_scdu>0) dhkecv05(i) = his_dhkecv(i, id_scdu)
3902	IF(id_prec>0) d_tr_ds01(i) = his_ds(i, id_prec)
3903	IF(id_fine>0) d_tr_ds02(i) = his_ds(i, id_fine)
3904	IF(id_coss>0) d_tr_ds03(i) = his_ds(i, id_coss)
3905	IF(id_codu>0) d_tr_ds04(i) = his_ds(i, id_codu)
3906	IF(id_scdu>0) d_tr_ds05(i) = his_ds(i, id_scdu)
3907	IF(id_prec>0) dhkelsc01(i) = his_dhkelsc(i, id_prec)
3908	IF(id_fine>0) dhkelsc02(i) = his_dhkelsc(i, id_fine)
3909	IF(id_coss>0) dhkelsc03(i) = his_dhkelsc(i, id_coss)
3910	IF(id_codu>0) dhkelsc04(i) = his_dhkelsc(i, id_codu)
3911	IF(id_scdu>0) dhkelsc05(i) = his_dhkelsc(i, id_scdu)
3912	u10m_ss(i) = u10m_ec(i)
3913	v10m_ss(i) = v10m_ec(i)
3914	ENDDO
3915	! 3D outs
3916	DO i = 1, klon
3917	DO k = 1, klev
3918	d_tr_cv01(i, k) = 0.
3919	d_tr_cv02(i, k) = 0.
3920	d_tr_cv03(i, k) = 0.
3921	d_tr_cv04(i, k) = 0.
3922	d_tr_cv05(i, k) = 0.
3923	d_tr_trsp01(i, k) = 0.
3924	d_tr_trsp02(i, k) = 0.
3925	d_tr_trsp03(i, k) = 0.
3926	d_tr_trsp04(i, k) = 0.
3927	d_tr_trsp05(i, k) = 0.
3928	d_tr_sscav01(i, k) = 0.
3929	d_tr_sscav02(i, k) = 0.
3930	d_tr_sscav03(i, k) = 0.
3931	d_tr_sscav04(i, k) = 0.
3932	d_tr_sscav05(i, k) = 0.
3933	d_tr_sat01(i, k) = 0.
3934	d_tr_sat02(i, k) = 0.
3935	d_tr_sat03(i, k) = 0.
3936	d_tr_sat04(i, k) = 0.
3937	d_tr_sat05(i, k) = 0.
3938	d_tr_uscav01(i, k) = 0.
3939	d_tr_uscav02(i, k) = 0.
3940	d_tr_uscav03(i, k) = 0.
3941	d_tr_uscav04(i, k) = 0.
3942	d_tr_uscav05(i, k) = 0.
3943	d_tr_insc01(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3944	d_tr_insc02(i, k) = 0.
3945	d_tr_insc03(i, k) = 0.
3946	d_tr_insc04(i, k) = 0.
3947	d_tr_insc05(i, k) = 0.
3948	d_tr_bcscav01(i, k) = 0.
3949	d_tr_bcscav02(i, k) = 0.
3950	d_tr_bcscav03(i, k) = 0.
3951	d_tr_bcscav04(i, k) = 0.
3952	d_tr_bcscav05(i, k) = 0.
3953	d_tr_evapls01(i, k) = 0.
3954	d_tr_evapls02(i, k) = 0.
3955	d_tr_evapls03(i, k) = 0.
3956	d_tr_evapls04(i, k) = 0.
3957	d_tr_evapls05(i, k) = 0.
3958	d_tr_ls01(i, k) = 0.
3959	d_tr_ls02(i, k) = 0.
3960	d_tr_ls03(i, k) = 0.
3961	d_tr_ls04(i, k) = 0.
3962	d_tr_ls05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3963	d_tr_dyn01(i, k) = 0.
3964	d_tr_dyn02(i, k) = 0.
3965	d_tr_dyn03(i, k) = 0.
3966	d_tr_dyn04(i, k) = 0.
3967	d_tr_dyn05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3968	d_tr_cl01(i, k) = 0.
3969	d_tr_cl02(i, k) = 0.
3970	d_tr_cl03(i, k) = 0.
3971	d_tr_cl04(i, k) = 0.
3972	d_tr_cl05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3973	d_tr_th01(i, k) = 0.
3974	d_tr_th02(i, k) = 0.
3975	d_tr_th03(i, k) = 0.
3976	d_tr_th04(i, k) = 0.
3977	d_tr_th05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3978	ENDDO
3979	ENDDO
3980
3981	IF(1==0) THEN
3982	! calcul in original trunk version; problem: budget not closed. Corrected in "ELSE"
3983	DO i = 1, klon
3984	DO k = 1, klev
3985
3986	IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
3987	IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
3988	IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
3989	IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
3990	IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
3991	IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
3992	IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
3993	IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
3994	IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
3995	IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
3996	IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
3997	IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
3998	IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
3999	IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
4000	IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
4001	IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
4002	IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
4003	IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
4004	IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
4005	IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
4006	IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
4007	IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
4008	IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
4009	IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
4010	IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
4011	IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
4012	IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
4013	IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
4014	IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
4015	IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
4016	IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
4017	IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
4018	IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
4019	IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
4020	IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
4021	IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
4022	IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
4023	IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
4024	IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
4025	IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
4026	ENDDO
4027	ENDDO
4028	ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
4029	DO i = 1, klon
4030	DO k = 1, klev
4031	IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
4032	IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
4033	IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
4034	IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
4035	IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
4036	IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
4037	IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
4038	IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
4039	IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
4040	IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
4041	IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
4042	IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
4043	IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
4044	IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
4045	IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
4046	IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
4047	IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
4048	IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
4049	IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
4050	IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
4051	IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
4052	IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
4053	IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
4054	IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
4055	IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
4056	IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
4057	IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
4058	IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
4059	IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
4060	IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
4061	IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
4062	IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
4063	IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
4064	IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
4065	IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
4066	IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
4067	IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
4068	IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
4069	IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
4070	IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
4071	ENDDO
4072	ENDDO
4073	ENDIF
4074
4075	IF(1==0) THEN ! This "if" is as in original trunk
4076	DO i = 1, klon
4077	DO k = 1, klev
4078	IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
4079	IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
4080	IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
4081	IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
4082	IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
4083	IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
4084	IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
4085	IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
4086	IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
4087	IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
4088	IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
4089	IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
4090	IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
4091	IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
4092	IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
4093	IF(id_prec>0) d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
4094	IF(id_fine>0) d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
4095	IF(id_coss>0) d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
4096	IF(id_codu>0) d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
4097	IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
4098	ENDDO
4099	ENDDO
4100	ELSE
4101	DO i = 1, klon
4102	DO k = 1, klev
4103	IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
4104	IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
4105	IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
4106	IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
4107	IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
4108	IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
4109	IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
4110	IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
4111	IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
4112	IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
4113	IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
4114	IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
4115	IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
4116	IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
4117	IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
4118	IF(id_prec>0) d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
4119	IF(id_fine>0) d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
4120	IF(id_coss>0) d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
4121	IF(id_codu>0) d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
4122	IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
4123	ENDDO
4124	ENDDO
4125	ENDIF
4126
4127	IF (logitime) THEN
4128	CALL SYSTEM_CLOCK(COUNT = clock_end)
4129
4130	dife = clock_end - clock_start
4131	ti_outs = dife * MAX(0, SIGN(1, dife)) &
4132	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4133	tia_outs = tia_outs + REAL(ti_outs) / REAL(clock_rate)
4134	ENDIF
4135
4136	IF (logitime) THEN
4137	CALL SYSTEM_CLOCK(COUNT = clock_end)
4138
4139	dife = clock_end - clock_start_spla
4140	ti_spla = dife * MAX(0, SIGN(1, dife)) &
4141	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4142
4143	tia_spla = tia_spla + REAL(ti_spla) / REAL(clock_rate)
4144	print *, 'times for this timestep:timeproc,timeproc/time_pytracr_spl-'
4145	print *, 'time spla', REAL(ti_spla) / REAL(clock_rate) &
4146	, REAL(ti_spla) / REAL(ti_spla)
4147	print *, 'time init', REAL(ti_init) / REAL(clock_rate) &
4148	, REAL(ti_init) / REAL(ti_spla)
4149	print *, 'time inittype', REAL(ti_inittype) / REAL(clock_rate) &
4150	, REAL(ti_inittype) / REAL(ti_spla)
4151	print *, 'time inittwrite', REAL(ti_inittwrite) / REAL(clock_rate) &
4152	, REAL(ti_inittwrite) / REAL(ti_spla)
4153	print *, 'time emis', REAL(ti_emis) / REAL(clock_rate) &
4154	, REAL(ti_emis) / REAL(ti_spla)
4155	print *, 'time depo ', REAL(ti_depo) / REAL(clock_rate) &
4156	, REAL(ti_depo) / REAL(ti_spla)
4157	print *, 'time cltr', REAL(ti_cltr) / REAL(clock_rate) &
4158	, REAL(ti_cltr) / REAL(ti_spla)
4159	print *, 'time ther', REAL(ti_ther) / REAL(clock_rate) &
4160	, REAL(ti_ther) / REAL(ti_spla)
4161	print *, 'time sedi', REAL(ti_sedi) / REAL(clock_rate) &
4162	, REAL(ti_sedi) / REAL(ti_spla)
4163	print *, 'time gas to part', REAL(ti_gasp) / REAL(clock_rate) &
4164	, REAL(ti_gasp) / REAL(ti_spla)
4165	print *, 'time AP wet', REAL(ti_wetap) / REAL(clock_rate) &
4166	, REAL(ti_wetap) / REAL(ti_spla)
4167	print *, 'time convective', REAL(ti_cvltr) / REAL(clock_rate) &
4168	, REAL(ti_cvltr) / REAL(ti_spla)
4169	print *, 'time NP lsc scav', REAL(ti_lscs) / REAL(clock_rate) &
4170	, REAL(ti_lscs) / REAL(ti_spla)
4171	print *, 'time opt,brdn,etc', REAL(ti_brop) / REAL(clock_rate) &
4172	, REAL(ti_brop) / REAL(ti_spla)
4173	print *, 'time outputs', REAL(ti_outs) / REAL(clock_rate) &
4174	, REAL(ti_outs) / REAL(ti_spla)
4175
4176	print *, '--time accumulated: time proc, time proc/time phytracr_spl--'
4177	print *, 'time spla', tia_spla
4178	print *, 'time init', tia_init, tia_init / tia_spla
4179	print *, 'time inittype', tia_inittype, tia_inittype / tia_spla
4180	print *, 'time inittwrite', tia_inittwrite, tia_inittwrite / tia_spla
4181	print *, 'time emis', tia_emis, tia_emis / tia_spla
4182	print *, 'time depo', tia_depo, tia_depo / tia_spla
4183	print *, 'time cltr', tia_cltr, tia_cltr / tia_spla
4184	print *, 'time ther', tia_ther, tia_ther / tia_spla
4185	print *, 'time sedi', tia_sedi, tia_sedi / tia_spla
4186	print *, 'time gas to part', tia_gasp, tia_gasp / tia_spla
4187	print *, 'time AP wet', tia_wetap, tia_wetap / tia_spla
4188	print *, 'time convective', tia_cvltr, tia_cvltr / tia_spla
4189	print *, 'time NP lsc scav', tia_lscs, tia_lscs / tia_spla
4190	print *, 'time opt,brdn,etc', tia_brop, tia_brop / tia_spla
4191	print *, 'time outputs', tia_outs, tia_outs / tia_spla
4192
4193	dife = clock_end_outphytracr - clock_start_outphytracr
4194	ti_nophytracr = dife * MAX(0, SIGN(1, dife)) &
4195	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4196	tia_nophytracr = tia_nophytracr + REAL(ti_nophytracr) / REAL(clock_rate)
4197	print *, 'Time outside phytracr; Time accum outside phytracr'
4198	PRINT*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
4199
4200	clock_start_outphytracr = clock_end
4201
4202	ENDIF
4203	print *, 'END PHYTRACR_SPL '
4204	print *, 'lmt_so2ff_l FIN', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
4205
4206	! CALL abort_gcm('TEST1', 'OK1', 1)
4207
4208
4209	END SUBROUTINE phytracr_spl
4210
4211	SUBROUTINE readregionsdims2_spl(nbreg, fileregions)
4212
4213	USE lmdz_grid_phy
4214	USE lmdz_phys_para
4215
4216	IMPLICIT NONE
4217	CHARACTER*800 fileregions
4218	CHARACTER*800 auxstr
4219	INTEGER nbreg
4220
4221	IF (is_mpi_root .AND. is_omp_root) THEN
4222
4223	OPEN (UNIT = 1, FILE = trim(adjustl(fileregions)))
4224	READ(1, '(a)') auxstr
4225	READ(1, '(i10)') nbreg
4226	CLOSE(UNIT = 1)
4227	ENDIF
4228	CALL bcast(nbreg)
4229
4230	END SUBROUTINE readregionsdims2_spl
4231
4232	SUBROUTINE readregionsdims_spl(nbreg_ind, fileregionsdimsind, &
4233	nbreg_dust, fileregionsdimsdust, &
4234	nbreg_bb, fileregionsdimsbb)
4235	USE lmdz_grid_phy
4236	USE lmdz_phys_para
4237
4238	IMPLICIT NONE
4239	CHARACTER*800 fileregionsdimsind
4240	CHARACTER*800 fileregionsdimsdust
4241	CHARACTER*800 fileregionsdimsbb
4242	CHARACTER*800 auxstr
4243	INTEGER nbreg_ind, nbreg_dust, nbreg_bb
4244
4245	IF (is_mpi_root .AND. is_omp_root) THEN
4246
4247	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsind)))
4248	READ(1, '(a)') auxstr
4249	READ(1, '(i10)') nbreg_ind
4250	CLOSE(UNIT = 1)
4251
4252	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsdust)))
4253	READ(1, '(a)') auxstr
4254	READ(1, '(i10)') nbreg_dust
4255	CLOSE(UNIT = 1)
4256
4257	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsbb)))
4258	READ(1, '(a)') auxstr
4259	READ(1, '(i10)') nbreg_bb
4260	CLOSE(UNIT = 1)
4261
4262	ENDIF
4263	CALL bcast(nbreg_ind)
4264	CALL bcast(nbreg_dust)
4265	CALL bcast(nbreg_bb)
4266
4267	END SUBROUTINE readregionsdims_spl
4268
4269	SUBROUTINE readregions_spl(iregion, filenameregion)
4270	USE dimphy
4271	USE lmdz_grid_phy
4272	USE lmdz_phys_para
4273
4274	IMPLICIT NONE
4275	CHARACTER() filenameregion
4276	INTEGER iregion(klon)
4277	INTEGER iregion_glo(klon_glo)
4278	INTEGER k
4279
4280	IF (is_mpi_root .AND. is_omp_root) THEN
4281
4282	print *, trim(adjustl(filenameregion))
4283	OPEN(1, file = trim(adjustl(filenameregion)))
4284	DO k = 1, klon_glo
4285	READ(1, '(i10)') iregion_glo(k)
4286	ENDDO
4287	CLOSE(UNIT = 1)
4288	ENDIF
4289	CALL scatter(iregion_glo, iregion)
4290
4291	END SUBROUTINE readregions_spl
4292
4293	!! AS: SUBROUTINE readscaleparams_spl pas appellee
4294	SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
4295	filescaleparams)
4296	USE lmdz_grid_phy
4297	USE lmdz_phys_para
4298	IMPLICIT NONE
4299
4300	CHARACTER*800 filescaleparams
4301	INTEGER nbreg
4302	REAL scale_param(nbreg)
4303	INTEGER k
4304
4305	IF (is_mpi_root .AND. is_omp_root) THEN
4306	OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
4307	do k = 1, nbreg
4308	read(1) scale_param(k)
4309	enddo
4310	CLOSE(1)
4311	ENDIF
4312	CALL bcast(scale_param)
4313	! print *,'holaaaaaaaaaaaa'
4314	! print *,scale_param
4315
4316	END SUBROUTINE readscaleparams_spl
4317
4318	SUBROUTINE readscaleparamsnc_spl(scale_param_ind, &
4319	nbreg_ind, paramname_ind, &
4320	scale_param_ff, nbreg_ff, paramname_ff, &
4321	scale_param_bb, nbreg_bb, paramname_bb, &
4322	scale_param_dustacc, nbreg_dustacc, paramname_dustacc, &
4323	scale_param_dustcoa, nbreg_dustcoa, paramname_dustcoa, &
4324	scale_param_dustsco, nbreg_dustsco, paramname_dustsco, &
4325	param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL, &
4326	param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, &
4327	scale_param_ssacc, paramname_ssacc, &
4328	scale_param_sscoa, paramname_sscoa, &
4329	filescaleparams, julien, jH_phys, pdtphys, debutphy)
4330	! SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, &
4331	! filescaleparams,paramname,&
4332	! julien,jH_phys, pdtphys,debutphy)
4333	USE lmdz_grid_phy
4334	USE lmdz_phys_para
4335	IMPLICIT NONE
4336
4337	CHARACTER*800 filescaleparams
4338	CHARACTER*100 paramname_ind, paramname_ff, paramname_bb
4339	CHARACTER*100 paramname_dustacc, paramname_dustcoa
4340	CHARACTER*100 paramname_dustsco
4341	CHARACTER*100 paramname_ssacc
4342	CHARACTER*100 paramname_sscoa
4343	CHARACTER*100 paramname_wstarBL
4344	CHARACTER*100 paramname_wstarWAKE
4345
4346	INTEGER nbreg, iday
4347	INTEGER nbreg_ind, nbreg_ff, nbreg_bb, nbreg_dustacc
4348	INTEGER nbreg_dustcoa, nbreg_dustsco, nbreg_wstardustBL
4349	INTEGER nbreg_wstardustWAKE
4350	INTEGER, PARAMETER :: nbreg_ssacc = 1
4351	INTEGER, PARAMETER :: nbreg_sscoa = 1
4352	REAL, PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours
4353	REAL scale_param_ind(nbreg_ind)
4354	REAL scale_param_bb(nbreg_bb)
4355	REAL scale_param_ff(nbreg_ff)
4356	REAL scale_param_dustacc(nbreg_dustacc)
4357	REAL scale_param_dustcoa(nbreg_dustcoa)
4358	REAL scale_param_dustsco(nbreg_dustsco)
4359	REAL param_wstarBLperregion(nbreg_wstardustBL)
4360	REAL param_wstarWAKEperregion(nbreg_wstardustWAKE)
4361	REAL scale_param_ssacc
4362	REAL scale_param_ssacc_tmp(nbreg_ssacc)
4363	REAL scale_param_sscoa
4364	REAL scale_param_sscoa_tmp(nbreg_sscoa)
4365
4366	INTEGER k, step_sca, test_sca
4367	REAL :: jH_phys, pdtphys
4368	REAL, SAVE :: jH_sca, jH_ini
4369	INTEGER julien
4370	LOGICAL debutphy
4371	SAVE step_sca, test_sca, iday
4372	!$OMP THREADPRIVATE(step_sca,test_sca,iday)
4373	!$OMP THREADPRIVATE(jH_sca,jH_ini)
4374
4375	IF (debutphy) THEN
4376	iday = julien
4377	step_sca = 1
4378	test_sca = 0
4379	jH_ini = jH_phys
4380	jH_sca = jH_phys
4381	ENDIF
4382
4383	IF (test_sca == 0) THEN
4384	! READ file!!
4385	CALL read_scalenc(filescaleparams, paramname_ind, &
4386	nbreg_ind, step_sca, &
4387	scale_param_ind)
4388	CALL read_scalenc(filescaleparams, paramname_bb, &
4389	nbreg_bb, step_sca, &
4390	scale_param_bb)
4391	CALL read_scalenc(filescaleparams, paramname_ff, &
4392	nbreg_ff, step_sca, &
4393	scale_param_ff)
4394	CALL read_scalenc(filescaleparams, paramname_dustacc, &
4395	nbreg_dustacc, step_sca, &
4396	scale_param_dustacc)
4397	CALL read_scalenc(filescaleparams, paramname_dustcoa, &
4398	nbreg_dustcoa, step_sca, &
4399	scale_param_dustcoa)
4400	CALL read_scalenc(filescaleparams, paramname_dustsco, &
4401	nbreg_dustsco, step_sca, &
4402	scale_param_dustsco)
4403	CALL read_scalenc(filescaleparams, paramname_wstarBL, &
4404	nbreg_wstardustBL, step_sca, &
4405	param_wstarBLperregion)
4406	CALL read_scalenc(filescaleparams, paramname_wstarWAKE, &
4407	nbreg_wstardustWAKE, step_sca, &
4408	param_wstarWAKEperregion)
4409	CALL read_scalenc(filescaleparams, paramname_ssacc, &
4410	nbreg_ssacc, step_sca, &
4411	scale_param_ssacc_tmp)
4412	CALL read_scalenc(filescaleparams, paramname_sscoa, &
4413	nbreg_sscoa, step_sca, &
4414	scale_param_sscoa_tmp)
4415	scale_param_ssacc = scale_param_ssacc_tmp(1)
4416	scale_param_sscoa = scale_param_sscoa_tmp(1)
4417
4418	!print *,'JEREADFILE',julien,jH_phys
4419	step_sca = step_sca + 1
4420	test_sca = 1
4421	ENDIF
4422
4423	jH_sca = jH_sca + pdtphys / (24. * 3600.)
4424	IF (jH_sca>(sca_resol) / 24.) THEN
4425	test_sca = 0
4426	jH_sca = jH_ini
4427	ENDIF
4428
4429	END SUBROUTINE readscaleparamsnc_spl
4430
4431	SUBROUTINE read_scalenc(filescaleparams, paramname, nbreg, step_sca, &
4432	scale_param)
4433
4434	USE lmdz_grid_phy
4435	USE lmdz_phys_para
4436	USE netcdf, ONLY: nf90_open, nf90_close, nf90_inq_varid, nf90_nowrite, nf90_noerr, nf90_get_var
4437	IMPLICIT NONE
4438
4439	CHARACTER*800 filescaleparams
4440	CHARACTER*100 paramname
4441	INTEGER nbreg, step_sca
4442	REAL scale_param(nbreg)
4443	!local vars
4444	INTEGER nid, ierr, nvarid
4445	REAL rcode, auxreal
4446	INTEGER start(4), count(4), status
4447	! local
4448	CHARACTER*104 varname
4449	CHARACTER*2 aux_2s
4450	INTEGER i, j, ig
4451	!$OMP MASTER
4452	IF (is_mpi_root .AND. is_omp_root) THEN
4453	ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
4454	IF (ierr == nf90_noerr) THEN
4455	do i = 1, nbreg
4456	WRITE(aux_2s, '(i2.2)') i
4457	varname = trim(adjustl(paramname)) // aux_2s
4458	print *, varname
4459	ierr = nf90_inq_varid(nid, trim(adjustl(varname)), nvarid)
4460	ierr = nf90_get_var(nid, nvarid, auxreal, [step_sca])
4461	IF (ierr /= nf90_noerr) THEN
4462	PRINT*, 'Pb de lecture pour modvalues'
4463	print *, 'JE scale_var, step_sca', trim(adjustl(varname)), step_sca
4464	CALL HANDLE_ERR(ierr)
4465	print *, 'error ierr= ', ierr
4466	CALL exit(1)
4467	CALL abort_gcm('read_scalenc', 'error reading variable', 1)
4468	ENDIF
4469
4470	print *, auxreal
4471	scale_param(i) = auxreal
4472	enddo
4473
4474	ierr = nf90_close(nid)
4475	else
4476	print *, 'File ' // trim(adjustl(filescaleparams)) // ' not found'
4477	print *, 'doing nothing...'
4478	endif
4479
4480	ENDIF ! mpi_root
4481	!$OMP END MASTER
4482	!$OMP BARRIER
4483	! CALL scatter(var local _glo,var local) o algo asi
4484	CALL bcast(scale_param)
4485	END SUBROUTINE read_scalenc
4486
4487
4488	END MODULE

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

Download in other formats:

Original Format