Context Navigation

phytracr_spl_mod.F90 @ 5277

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

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

Download in other formats:

Original Format