Context Navigation

phytracr_spl_mod.F90 @ 4157

Last change on this file since 4157 was 4157, checked in by asima, 2 years ago

Adjustments to changes in tracer treatment made by D. Cugnet :

replacing "it" by "itr"

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

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

Download in other formats:

Original Format